10:57 PM 30-MAR-98 Radiology patch 2 routines RAWKL1 RAWKL1 ; IHS/ISD/PDW -Radiology Workload Reports 11:58 ; [ 03/30/98 10:56 PM ] ;;4.0;RADIOLOGY;**2**;MAR 22, 1998 ;Mod to pause at end of screen & allow ^ out **2** IHS/ISD/EDE 03/22/98 NEW RAZQ S RAZQ=0 ; Added for **2** IHS/ISD/EDE 03/22/98 S PAGE=0 I $O(^TMP($J,"RA",0))'>0 W @IOF,!!?5,"No exams registered for time period " S Y=BEGDATE D D^RAUTL W Y," to " S Y=ENDDATE D D^RAUTL W Y,".",! G Q ;Mod following line to quit if RAZQ for **2** IHS/ISD/EDE 03/22/98 F RADIV=0:0 Q:RAZQ S RADIV=$O(^TMP($J,"RA",RADIV)) Q:RADIV'>0 S RAZ=^(RADIV),RAY=$S($D(^DIC(4,RADIV,0)):$P(^(0),"^"),1:"UNKNOWN") D:$D(RAFL1) RAFLD Q:RAZQ S RASUM="",Z=RAZ,ZZ=")",ZZZ="RAFLD" D HD,PRT D:'RAZQ TOT K RASUM Q K ^TMP($J,"RA"),A,BEGDATE,C,ENDDATE,I,IN,J,OUT,PAGE,POP,RABEG,RACNI,RAD0,RADFN,RADIV,RADTE,RADTI,RAEND,RAFILE,RAFL,RAFL1,RAFL3,RAFLD,RAI,RAIN,RAMIS,RAMUL,RAOR,RAOUT,RAP0,RAPCE,RAPORT,RAPRC,RAPRI,RAQI,RASUM,RATITLE,RATOT ;Added next line to pause before exit **2** IHS/ISD/EDE 03/22/98 D:'RAZQ PAUSE ; **2** IHS/ISD/EDE 03/22/98 K RACRT,RASTAT,RANUM,RAWT,RAWWU,RAY,RAZ,RACPT,RAPIFN,RASV,RATCI,TOT,WWU,X,Y,Z,ZZ,ZZZ W ! D CLOSE^RAUTL Q ; ;Mod following line to quit if RAZQ for **2** IHS/ISD/EDE 03/22/98 RAFLD S RAFLD="" F J=0:0 Q:RAZQ S RAFLD=$O(^TMP($J,"RA",RADIV,"FLD",RAFLD)) Q:RAFLD="" S Z=^(RAFLD) D HD,RAMIS Q ; ;Mod following line to quit if RAZQ for **2** IHS/ISD/EDE 03/22/98 RAMIS F RAMIS=0:0 Q:RAZQ S RAMIS=$O(^TMP($J,"RA",RADIV,"FLD",RAFLD,"A",RAMIS)) D:RAMIS'>0 TOT Q:RAMIS'>0 S ZZ=",""A"",RAMIS,""P"",RAPRC)",ZZZ="RAPRC" D:RAMIS<25!(RAMIS=99) PRT Q ; PRT S IN=$P(Z,"^"),OUT=$P(Z,"^",2),TOT=IN+OUT,WWU=$P(Z,"^",3) ;Mod following line to quit if RAZQ for **2** IHS/ISD/EDE 03/22/98 S @ZZZ="" F I=0:0 Q:RAZQ S @ZZZ=$O(@("^TMP($J,""RA"",RADIV,""FLD"",RAFLD"_ZZ)) Q:@ZZZ="" S Y=^(@ZZZ),RAIN=$P(Y,"^"),RAOUT=$P(Y,"^",2),RAWWU=$P(Y,"^",3),RATOT=RAIN+RAOUT D PRT1 Q ; TOT W !!?2,$S($D(RASUM):"Division",1:RATITLE)," Total",?40,$J(IN,5),?47,$J(OUT,5),?54,$J(TOT,5) W:$D(RAFL) ?68,$J(WWU,5) I '$D(RASUM) W ! F I=1:1:79 W "-" I $D(RASUM),'RAPCE W !!!?2,"NOTE: Since a procedure can be performed by more than one technologist,",!?8,"the total number of exams and weighted work units by division is",!?8,"likely to be higher than the other workload reports." Q ;W !,?5,"*** Portables and Operating Room Exams ***" ;F RAMIS=25,26 I $D(^TMP($J,"RA",RADIV,"FLD",RAFLD,"A",RAMIS)) S ZZ=",""A"",RAMIS,""P"",RAPRC)",ZZZ="RAPRC" D PRT S RAFL3="" ;W:'$D(RAFL3) !?10,"None" K RAFL3 S RAMIS=-1 Q ; ;Mod following line to quit if RAZQ for **2** IHS/ISD/EDE 03/22/98 PRT1 D HD:($Y+4)>IOSL Q:RAZQ W !,@ZZZ,?40,$J(RAIN,5),?47,$J(RAOUT,5),?54,$J(RATOT,5),?61,$J($S(TOT:(100*RATOT)/TOT,1:0),5,1) W:$D(RAFL) ?68,$J(RAWWU,5),?75,$J($S(WWU:(RAWWU*100)/WWU,1:0),5,1) Q ; ;Mod HD line to pause at end of screen for **2** IHS/ISD/EDE 03/22/98 ;Mod HD line to quit if RAZQ for **2** IHS/ISD/EDE 03/22/98 HD D:PAGE PAUSE Q:RAZQ W @IOF,!?5,">>>>> Diagnostic Radiology ",RATITLE," Workload Report <<<<<" S PAGE=PAGE+1 W ?70,"Page: ",PAGE W !!?1,"Division: ",RAY,?52,"For period: " S Y=BEGDATE D D^RAUTL W ?64,Y,?76,"to" S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL W !?1,"Run Date: ",Y S Y=ENDDATE D D^RAUTL W ?64,Y W !!?45,"Examinations",?61,"Percent" W:$D(RAFL) ?73,"Percent" W !?2,$S('$D(RASUM):"Procedure (CPT)",1:RATITLE),?40," In",?47," Out",?54,"Total",?61," Exams" W:$D(RAFL) ?67," WWU",?73," WWU" W ! F I=1:1:80 W "-" W:$D(RASUM) !?10,"(Division Summary)" W:'$D(RASUM) !?10,RATITLE,": ",RAFLD Q ;Added following 7 lines for **2** IHS/ISD/EDE 03/22/98 PAUSE ; EP - PAUSE FOR USER Q:$E(IOST)'="C" Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S")) S DIR(0)="E",DIR("A")="Press any key to continue" D ^DIR K DIR W ! I $D(DIRUT) K DIRUT S RAZQ=1 Q RAZPCCX RAZPCC ; IHS/ISD/EDE - RADIOLOGY PCC LINK ; [ 03/23/98 9:01 AM ] ;;4.0;RADIOLOGY;**2**;FEB 02, 1998 ; ; Patch 2 modified provider pointer being passed to PCC to ; be file 6 iens instead of file 200 iens. EDE/OHPRD/IHS 02/27/98 ; CREATE ;EP---> CREATE OR MODIFY A VISIT FILE ENTRY, CREATE A NEW V RAD ENTRY. ;S DUZ(0)="@" MWR >>No longer needed IHS/ISD/EDE 1/6/97 K APCDALVR N I,N,X ;---> QUIT IF PCC IS NOT PRESENT AT THIS SITE (RPMS SITE FILE). Q:$P(^AUTTSITE(1,0),U,8)'="Y" ;---> QUIT IF NO PCC MASTER CONTROL FILE FOR THIS SITE. Q:'$D(^APCCCTRL(DUZ(2))) ;---> QUIT IF RADIOLOGY IS NOT IN THE PACKAGE FILE. S DIC=9.4,DIC(0)="",X="RADIOLOGY" D ^DIC Q:Y<0 ;---> QUIT IF RADIOLOGY IS NOT IN PCC MASTER CONTROL FILE OR IF ;---> "PASS DATA TO PCC" IS "NO". Q:'$D(^APCCCTRL(DUZ(2),11,+Y,0)) Q:'$P(^APCCCTRL(DUZ(2),11,+Y,0),U,2) ;---> QUIT IF VISIT TYPE ISN'T DEFINED IN PCC MASTER CONTROL FILE. Q:$P(^APCCCTRL(DUZ(2),0),U,4)']"" ;---> QUIT IF NECESSARY RAD VARIABLES ARE NOT PRESENT. Q:'$D(RADFN) Q:'$D(RADTI) Q:'$D(RACNI) Q:'$D(RADTE) ;---> QUIT IF PCC DATE/TIME NODE DOES NOT EXIST. Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")) ; VISIT ;---> CREATE OR MODIFY VISIT IN VISIT FILE. ;---> SET RAZTEST=1 TO DISPLAY VISIT AND V RAD PTRS AFTER SET. S RAZTEST=0 ; ;---> PATIENT S APCDALVR("APCDPAT")=RADFN ; ;---> PCC DATE/TIME; IF NO TIME, ATTACH 12 NOON. S APCDALVR("APCDDATE")=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC"),U) I '$P(APCDALVR("APCDDATE"),".",2) S APCDALVR("APCDDATE")=APCDALVR("APCDDATE")_".12" ; ;---> LOCATION S APCDALVR("APCDLOC")=DUZ(2) ; ;---> VISIT TYPE FROM PCC MASTER CONTROL FILE. (I,C,T,6,V) S APCDALVR("APCDTYPE")=$P(^APCCCTRL(DUZ(2),0),U,4) ; ;---> TYPE OF LINK FROM PCC MASTER CTRL FILE; IF TIME REQ SET APCDAUTO. ;I $P(^APCCCTRL(DUZ(2),0),U,2) S APCDALVR("APCDAUTO")="" ;---> RADIOLOGY SOFTWARE WILL APPEND 12 NOON TO ANY VISIT WITHOUT TIME. S APCDALVR("APCDAUTO")="" ; ;---> CATEGORY S X=$S($P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,4)="I":"I",1:"A") S APCDALVR("APCDCAT")=X K X ; ;---> CLINIC ;RAM 4/19/95 S X=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,8) S X=$P($G(^SC(+X,0)),U,7) S X=$S(X:X,APCDALVR("APCDCAT")="A":57,1:0) S:X APCDALVR("APCDTCLN")="`"_X K X ; ;---> REQUESTING PROVIDER/ORDERING PROVIDER ;---> I $P(^AUTTSITE(1,0),U,22)) SEND 200 PTR. ;S X=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,14) ;S:$P(^AUTTSITE(1,0),U,22) X=^DIC(16,X,"A3") ;IHS/ISD/EDE 02/16/97 ; no longer necessary, converted to file 200 IHS/ISD/EDE 02/16/97 ;---> PATCH **2** CODE BEGINS IHS/ISD/EDE 01/07/98 ;---> FOLLOWING CODE CONVERTS TO FILE 16 IF NEEDED ;---> IT ASSUMES EVERY FILE 200 ENTRY HAS PERSON ;---> POINTER IN PIECE 16 OF 0TH NODE ;---> IT WORKS BECAUSE FILE 6 IS DINUM TO FILE 16 S X=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,14) I '$P($G(^AUTTSITE(1,0)),U,22) D . NEW A,P . S P=X,A=$P(^VA(200,P,0),U,16) . I A="" S X="" Q . I $P(^VA(200,P,0),U)'=$P(^DIC(16,A,0),U) S X="" Q . S X=A . Q S:X APCDALVR("APCDTPRV")="`"_X K X ;---> PROBABLY SHOULD NOTIFY USER IF X="" ;---> PATCH **2** CODE ENDS IHS/ISD/EDE 01/07/98 ; ;---> NO INTERACTION, NO FILEMAN ECHOING S APCDALVR("AUPNTALK")="",APCDALVR("APCDANE")="" ; D ^APCDALV D:RAZTEST DISPLAY1 ; ;---> QUIT IF VISIT WAS NOT CREATED. G:'$D(APCDALVR("APCDVSIT")) EXIT G:$D(APCDALVR("APCDAFLG")) EXIT ; ;RETURNS APCDVSIT - PTR TO VISIT JUST SELECTED OR CREATED ; APCDVSIT("NEW") - IF ^APCDALVR CREATED A NEW VISIT ; APCDAFLG - =2 IF FAILED TO CREATE VISIT ; VRAD ;---> CREATE (ADD) VISIT TO V RADIOLOGY FILE. ;V RADIOLOGY FILE#=9000010.22 S DLAYGO=9000010.22 ; ;---> RADIOLOGY PROCEDURE S APCDALVR("APCDTRAD")="`"_$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,2) ; ;---> RADIOLOGY PROCEDURE EVENT DATE/TIME S APCDALVR("APCDTCDT")=$P(^RADPT(RADFN,"DT",RADTI,0),U) ; ;---> ABNORMAL ; V RAD ^DD SHOULD BE MODIFIED TO TAKE DIAG CODES! ;---> 4/6/95: ;---> LORI WILL BE CHANGING THE .05 FIELD OF V RADIOLOGY TO POINT ;---> THE THE DIAGNOSTIC CODES FILE #78.3 SOMETIME SOON. FOR NOW ;---> FIELD #.05 IS STILL A SET OF CODES: NORMAL/ABNORMAL. ;S APCDALVR("APCDTABN")=0 ; ;---> 3/17/97 WE DECIDED TO LEAVE .05 FIELD AS IS FOR DIRECT DATA ;---> ENTRY AND ADDED A .06 FIELD FOR DIAGNOSTIC CODE IHS/ISD/EDE ;S APCDALVR("ACDTDC")="`"_$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13) ;---> REMOVE THE ; FROM ABOVE LINE WHEN PCC READY TO TAKE DIAGNOSTIC ;---> CODES ::IHS/ISD/EDE 03/17/97 ; ;---> IMPRESSION S APCDALVR("APCDTIMP")="NO IMPRESSION." I $D(^RARPT(RARPT,"I")) D .S I="",N=0 F S N=$O(^RARPT(RARPT,"I",N)) Q:'N D ..I $L(I)+$L(^RARPT(RARPT,"I",N,0))<120 S I=I_" "_^(0) Q ..S I=I_"...*MORE* (SEE EXAM).",N=-1 .I $L(I) S APCDALVR("APCDTIMP")=I ; ;---> TEMPLATE TO ADD VISIT TO V RADIOLOGY FILE. S APCDALVR("APCDATMP")="[APCDALVR 9000010.22 (ADD)]" D ^APCDALVR D:RAZTEST DISPLAY2 ; G:'$D(APCDALVR("APCDADFN")) EXIT G:$D(APCDALVR("APCDAFLG")) EXIT ; ; STORE ;---> STORE VISIT AND V RAD IEN'S IN RADIOLOGY EXAMS FILE #70 S X=APCDALVR("APCDADFN")_"^"_APCDALVR("APCDVSIT") S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC"),U,2,3)=X D:RAZTEST DISPLAY3 ; EXIT ; K I,N,RAZTEST,X Q ; ; DELETE ;EP---> DELETE PCC V RAD ENTRY. (REQUIRES RADFN, RADTI, & RACNI) ;---> CALLED FROM RARTE1 (DELETE A REPORT AND UNVERIFY A REPORT). I $D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,"PCC")) D .S DA=$P(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,"PCC"),U,2) .;---> QUIT IF POINTER TO VRAD FILE IS NULL. .Q:'+DA .S APCDVDLT=$P(^AUPNVRAD(DA,0),U,3) .S DIK="^AUPNVRAD(" D ^DIK .Q:APCDVDLT'=$P(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,"PCC"),U,3) .D:'$P(^AUPNVSIT(APCDVDLT,0),U,9) ^APCDVDLT .;---> SET PCC VISIT POINTERS FOR THIS EXAM = NULL. .S $P(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,"PCC"),U,2,3)="" Q ; ; DISPLAY1 ;---> DISPLAY VISIT IEN. I $D(APCDALVR("APCDVSIT")) D .W !,"APCDVSIT DEFINED: ",APCDALVR("APCDVSIT") I $D(APCDALVR("APCDVSIT","NEW")) D .W !,"NEW VISIT: ",APCDALVR("APCDVSIT","NEW") ;---> SHOW FLAG IF VISIT WAS NOT CREATED. I $D(APCDALVR("APCDAFLG")) D .W !,"APCDAFLG DEFINED, FAILED: ",APCDALVR("APCDAFLG") Q DISPLAY2 ;---> DISPLAY V RAD IEN. I $D(APCDALVR("APCDADFN")) D .W !,"APCDADFN DEFINED: ",APCDALVR("APCDADFN") ;---> SHOW FLAG IF VISIT WAS NOT CREATED. I $D(APCDALVR("APCDAFLG")) D .W !,"APCDAFLG DEFINED, FAILED: ",APCDALVR("APCDAFLG") Q DISPLAY3 ;---> DISPLAY VISIT AND V RAD GLOBAL NODES AND FILE#70 IENS. W !!,"VISIT FILE: " S N=APCDALVR("APCDVSIT")-3 F S N=$O(^AUPNVSIT(N)) Q:'N D .W !,N,": ",^AUPNVSIT(N,0) ; W !!,"V RAD FILE: " S N=APCDALVR("APCDADFN")-3,M=N+10 F S N=$O(^AUPNVRAD(N)) Q:'N Q:N>M D .W !,N,": ",^AUPNVRAD(N,0) W !,"EXAM IENS: ",RADFN," ",RADTI," ",RACNI Q RAZVRAD RAZVRAD ; IHS/OHPRD/EDE - FIX V RADIOLOGY PROVIDER POINTERS [ 03/22/98 6:58 PM ] ;;4.0;RADIOLOGY;**2**;FEB 25, 1998 ; ; This routine converts V RADIOLOGY field 1202 from file 200 ; pointers to file 6 pointers. The pointers are converted ; for VISITs added after the installation of Radiology v4.0 ; or after a date specified by the user. ; ; This logic is based on the assumption that there is a DINUM ; relationship between file 200 and file 3 and both files ; have a file 16 pointer in the 16th piece of the 0th node. ; It is further assumed that the .01 field value of file 200 ; and file 16 should be exactly the same. ; ; The file 6 pointer is taken from the 16th piece of the 0th ; node of file 200. If there is no 16th piece an entry is ; made in ^RAZVRAD(9000010.22, so someone can attempt to ; resolve these later. ; ; File 3 and file 200 entries that do not have a pointer in ; the 16th piece or where the .01 field of file 16 and 200 ; do not match are indentified and stored in ^RAZVRAD(file#, ; so these problems can be addressed. ; START ; D MAIN D EOJ Q ; MAIN ; D INIT Q:RAZQ D CONVERT Q ; INIT ; INITIALIZATION D CHKPRIOR ; chk for prior run Q:RAZQ D INTRO ; display intro message Q:RAZQ D CHKFILES ; chk file 3 and 200 for pointers Q:RAZQ D GETDATE ; get beginning visit date Q:RAZQ Q ; CHKPRIOR ; CHECK FOR PRIOR RUN S RAZQ=0 I $D(^RAZVRAD(9000010.22,"RUN DATE")) S Y=^("RUN DATE") D . X ^DD("DD") . W !!,"This routine was run on "_Y,! . I $G(^RAZVRAD(9000010.22,"CNVRT")) W "There were "_^("CNVRT")_" V Radiology entries convert so this routine cannot be run again!",!! S RAZQ=1 Q . W "There were no V Radiology entries converted so this routine can be run again." . Q Q ; INTRO ; DISPLAY INTRO MESSAGE W !!,"This routine will convert V Radiology provider pointers from",! W "file 200 pointers to file 6 pointers. The conversion will be",! W "done beginning on the date Radiology v4.0 was installed or by",! W "a date you specify when asked. The default date you will see is",! W "the v4.0 installation date. Consider that if you installed v4.0",! W "at 10:00pm you would not want to convert visits added that day.",! W !,"Errors will be stored in ^RAZVRAD(file#, so you can look at",! W "them using ^%GL.",! W !,"Before you do the conversion save ^AUPNVRAD to a host file so",! W "it can be restored if needed. It would be wise to look at a",! W "few V Radiology entries before and after the conversion to make",! W "sure they were converted correctly.",! W !,"You can run this routine in test mode so that everything will",! W "happen except the actual modification of the V Radiology pointer.",! S RAZQ=1 S DIR(0)="E",DIR("A")="Press any key to continue" KILL DA D ^DIR KILL DIR Q:$D(DIRUT) S DIR(0)="S^1:TEST;2:CANCEL;3:CONVERT",DIR("A")="Select",DIR("B")="1" KILL DA D ^DIR KILL DIR Q:$D(DIRUT) S RAZSTAT=Y S:RAZSTAT'=2 RAZQ=0 Q ; GETDATE ; GET BEGINNING VISIT DATE S RAZQ=0 D GETV4DT I RAZV4DT="" D Q:RAZQ . S RAZQ=1 . W !!,"I cannot find an entry for Radiology v4.0 in the Package file." . S DIR(0)="Y",DIR("A")="Do you want to convert V Radiology entries anyway",DIR("B")="NO" KILL DA D ^DIR KILL DIR . Q:$D(DIRUT) . S:Y RAZQ=0 . Q D GETBGDT Q:RAZQ Q ; GETV4DT ; GET V4.0 DATE S RAZV4DT="" S Y=$O(^DIC(9.4,"C","RA",0)) Q:'Y S Z=$O(^DIC(9.4,Y,22,"B","4.0T8",0)) I 'Z S Z=$O(^DIC(9.4,Y,22,"B","4.0",0)) Q:'Z S X=$P($G(^DIC(9.4,Y,22,Z,0)),U,3) Q:X="" S RAZV4DT=X Q ; GETBGDT ; GET BEGINNING DATE FOR CONVERSION S RAZQ=1 S RAZBGDT="" W ! S Y=RAZV4DT X ^DD("DD") S DIR(0)="D^::EP",DIR("A")="Enter beginning visit date",DIR("B")=Y KILL DA D ^DIR KILL DIR Q:$D(DIRUT) S RAZBGDT=Y S RAZQ=0 Q ; CHKFILES ; CHECK FILE 3 AND 200 FOR APPROPRIATE POINTERS S RAZQ=0 D CHKF200 ; chk file 200 D CHKF3 ; chk file 3 I $D(^RAZVRAD) D ASKUSR ; see if user wants to run with errors Q ; CHKF200 ; CHECK FILE 200 FOR FILE 16 POINTER W !!,"I am now going to check a few things in your New Person file" I $D(^RAZVRAD(200)) D I RAZQ S RAZQ=0 Q . S RAZQ=1 . W !!,"Errors exist from a previous run" . S DIR(0)="Y",DIR("A")="Do you want me to check this file again",DIR("B")="NO" KILL DA D ^DIR KILL DIR . Q:$D(DIRUT) . S:Y RAZQ=0 . Q NEW C,X,Y,Z S RAZFILE=200 K ^RAZVRAD(RAZFILE) S Y=0 F C=1:1 S Y=$O(^VA(200,Y)) Q:'Y I $D(^(Y,0)) D . W:'(C#10) "." . I '$D(^DIC(3,Y)) S RAZEMSG="No User file entry" D EMSG . S Z=$P($G(^VA(200,Y,0)),U,16) . I 'Z S RAZEMSG="No file 16 pointer" D EMSG Q . I '$D(^DIC(16,Z)) S RAZEMSG="No file 16 entry "_Z D EMSG Q . S X=$P($G(^DIC(16,Z,0)),U) . I $P(^VA(200,Y,0),U)'=X S RAZEMSG="File 200 and file 16 Name fields are different" D EMSG Q . Q Q ; CHKF3 ; CHECK FILE 3 FOR FILE 16 POINTER W !!,"I am now going to check a few things in your User file" I $D(^RAZVRAD(3)) D I RAZQ S RAZQ=0 Q . S RAZQ=1 . W !!,"Errors exist from a previous run" . S DIR(0)="Y",DIR("A")="Do you want me to check this file again",DIR("B")="NO" KILL DA D ^DIR KILL DIR . Q:$D(DIRUT) . S:Y RAZQ=0 . Q NEW C,X,Y,Z S RAZFILE=3 K ^RAZVRAD(RAZFILE) S Y=0 F C=1:1 S Y=$O(^DIC(3,Y)) Q:'Y I $D(^(Y,0)) D . W:'(C#10) "." . I '$D(^VA(200,Y)) S RAZEMSG="File 200 entry missing" D EMSG . S Z=$P($G(^DIC(3,Y,0)),U,16) . I 'Z S RAZEMSG="No file 16 pointer" D EMSG Q . I '$D(^DIC(16,Z)) S RAZEMSG="No file 16 entry "_Z D EMSG Q . S X=$P($G(^DIC(16,Z,0)),U) . Q:'$D(^VA(200,Y,0)) . I $P(^VA(200,Y,0),U)'=X S RAZEMSG="File 200 and file 16 Name fields are different" D EMSG Q . Q Q ; EMSG ; SAVE ERROR MESSAGE S (RAZEC,^("EC"))=$G(^RAZVRAD(RAZFILE,"EC"))+1 S ^RAZVRAD(RAZFILE,RAZEC)="File "_RAZFILE_" IEN "_Y_"="_RAZEMSG Q ; ASKUSR ; SEE IF USER WANTS TO RUN WITH FILE 3, 200 ERRORS S RAZQ=1 W ! I $G(^RAZVRAD(3,"EC")) W !,"There are "_^("EC")_" file 3 errors" I $G(^RAZVRAD(200,"EC")) W !,"There are "_^("EC")_" file 200 errors" S DIR(0)="Y",DIR("A")="Do you want to run anyway",DIR("B")="NO" KILL DA D ^DIR KILL DIR Q:$D(DIRUT) S:Y RAZQ=0 Q ; CONVERT ; CONVERT V RADIOLOGY POINTERS S RAZFILE=9000010.22 K ^RAZVRAD(RAZFILE) ; eliminate residue from old run I RAZSTAT=1 W !!,"Running in test mode" E S ^RAZVRAD(RAZFILE,"RUN DATE")=DT W !!,"Now converting V Radiology pointers" S RAZVRAD=0,C=0 F S RAZVRAD=$O(^AUPNVRAD(RAZVRAD)) Q:'RAZVRAD I $D(^(RAZVRAD,0)) S X=^(0) D . S C=C+1 . W:'(C#50) "." . S Y=$P(X,U,3) ; get visit pointer . Q:'Y ; not a good sign . S X=$P($G(^AUPNVSIT(Y,0)),U,2) ;get posting date . Q:X="" ; bad visit entry . Q:X