DG53659 ;EG - DG*5.3*659 Cleanup Radiation Exposure; 08/08/2006
;;5.3;Registration;**659**;Aug 13,1993;Build 20
;
POST ;
N U,ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK,ZTDTH
S U="^"
D BMES^XPDUTL("Queue-ing the job to reset Radiation Exposure Method...")
S ZTRTN="RUN^DG53659",ZTDESC="Reset Radiation Exposure Method"
S ZTIO="",ZTDTH=$$NOW^XLFDT D ^%ZTLOAD
D BMES^XPDUTL("This request queued as Task # "_$G(ZTSK))
D BMES^XPDUTL("=====================================================")
D BMES^XPDUTL("")
Q
EP ; Queue the conversion
N %
S %=$$NEWCP^XPDUTL("IEN12","RUN^DG53659(1)")
S %=$$NEWCP^XPDUTL("END","END^DG53659") ; Leave as last update
Q
;
END ; Post-install done
D BMES^XPDUTL("Post install complete.")
Q
RUN ;entry point from taskman
I '$$CHKSTAT(1) D Q
. D BMES^XPDUTL("Conversion routine already running, process aborted")
. Q
N TESTING
S TESTING="N" K ^TMP($$NAMSPC) D QUE
Q
TEST ;entry point for test mode
N TESTING,X,STARTID,ENDID,U,NAMSPC
S NAMSPC=$$NAMSPC
S TESTING="Y",U="^"
S X=$$CHKSTAT(0)
K ^XTMP(NAMSPC,"TEST RANGE"),^XTMP(NAMSPC,"TEST")
S STARTID=$$TESTID("Starting")
S ENDID=$$TESTID("Ending")
I ENDID<STARTID U 0 W !,?10,"Ending IEN can't be less than starting IEN"
S ^XTMP(NAMSPC,"TEST RANGE")=STARTID_U_ENDID
D QUE
Q
;
TESTID(MESS) ;
TESTIDG N X
U 0 W !!,MESS," DFN for Patient file? " R X:300
I X="" Q X
I X'?1N.N,X'?1N.N1"."1N.N W !,?10,"Must be numeric" G TESTIDG
Q X
;
QUE ;
N ZTSTOP,X,U,NAMSPC
S U="^"
I '$D(TESTING) N TESTING S TESTING="N"
S NAMSPC=$$NAMSPC
S X=$$SETUPX(90)
S X=$G(^XTMP(NAMSPC,0,0))
S $P(X,U,6)="RUNNING"
S $P(X,U,7)=$$NOW^XLFDT
S ^XTMP(NAMSPC,0,0)=X
;
S X=$$LOOP(NAMSPC,TESTING),ZTSTOP=$P(X,U,2)
S X=$G(^XTMP(NAMSPC,0,0))
S $P(X,U,6)=$S(ZTSTOP:"STOPPED",1:"COMPLETED")
S $P(X,U,8)=$$NOW^XLFDT
S ^XTMP(NAMSPC,0,0)=X
;
S X=$$MAIL^DG53659M(NAMSPC,TESTING,DUZ)
K TESTING
L -^XTMP(NAMSPC)
Q
;
SETUPX(EXPDAYS) ;
; requires EXPDAYS - number of days to keep XTMP around
N BEGTIME,PURGDT,NAMSPC,U
S U="^"
S NAMSPC=$$NAMSPC
S BEGTIME=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAYS)
S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
S $P(^XTMP(NAMSPC,0),U,3)="Convert Radiation Exposure Method"
Q 1
;
LOOP(NAMSPC,TESTING) ;
;returns 0^stop flag
N X,XREC,LASTREC,TOTREC,TOTPAT
N U,ZTSTOP,REXP
S LASTREC="",U="^",ZTSTOP=0
S TOTREC=0
I $D(^XTMP(NAMSPC,0,0)) D
. S XREC=$G(^XTMP(NAMSPC,0,0))
. ;last DFN processed
. S LASTREC=+$P(XREC,U,1)
. ;total records read
. S TOTREC=+$P(XREC,U,2)
. S TOTPAT=+$P(XREC,U,10)
. Q
D DFN
Q 0_"^"_ZTSTOP
;
DFN N DFN,END,X
S DFN="",END=9999999999999999999999
S X=$G(^XTMP(NAMSPC,"TEST RANGE")) I $L(X) D
. S DFN=$P(X,U,1)-1,END=$P(X,U,2)
. Q
S ZTSTOP=0
F S DFN=$O(^DPT(DFN)) Q:DFN=""!ZTSTOP!(DFN?1A.E) D CHKR
Q
;
CHKR N X,U,NEW
S U="^"
I DFN>END S ZTSTOP=2 Q
S LASTREC=DFN
S TOTREC=TOTREC+1
I (TOTREC#20)=0 S ZTSTOP=$$STOP(NAMSPC) I ZTSTOP=1 Q
S X=$$CHPAT(DFN) I $P(X,U,1)="Y" D
. S NEW=$P(X,U,2),TOTPAT=TOTPAT+1
. I TESTING="N" D
. . N DA,DIE,DR,X
. . S DA=DFN,DIE="^DPT(",DR=".3212////"_NEW
. . D ^DIE
. . Q
. Q
S X=$$UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT)
Q
CHPAT(DFN) ;
N X,U,RET,VAL
S U="^",RET="N"
S X=$G(^DPT(DFN,.321))
S VAL=$P(X,U,12)
I VAL?1N,VAL>1,VAL<8 Q RET
I $L(VAL) D
. I $P($G(^DPT(DFN,.321)),U,3)="Y" S RET="Y^"_$S(VAL="N":2,VAL="T":3,VAL="B":4,1:3) Q
. ;if radiation exposure indicated is set to 'No', delete radiation exposure method
. S RET="Y^@"
. Q
;bulk fill to 3 if radiation exposure method is null
;and radiation exposure indicated is "Y"
I '$L(VAL),$P($G(^DPT(DFN,.321)),U,3)="Y" D
. S RET="Y^3"
. Q
Q RET
;
UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT) ;
N X,U
S U="^",X=$G(^XTMP(NAMSPC,0,0))
S $P(X,U,1)=$G(LASTREC),$P(X,U,2)=$G(TOTREC)
S $P(X,U,10)=$G(TOTPAT)
S ^XTMP(NAMSPC,0,0)=X
Q 1
STATUS ;display status of current run
N X,NAMSPC,U,OLD
S U="^"
S NAMSPC=$$NAMSPC
S X=$G(^XTMP(NAMSPC,0,0))
I X="" U 0 W !!,"Task not started!!!" Q
W !!," Current status: ",$P(X,U,6)
W !," Starting time: ",$$FMTE^XLFDT($P(X,U,7))
I $P(X,U,8) D
. W !," Ending time: ",$$FMTE^XLFDT($P(X,U,8))
. Q
W !!," Total patient records read: ",$P(X,U,2)
W !," Last patient record processed: ",$P(X,U,1)
W !," Total patient records changed: ",$P(X,U,10)
Q
;
STOP(NAMSPC) ;
N ZSTSTOP,U,X
S U="^"
;returns stop flag
S ZTSTOP=0
I $$S^%ZTLOAD S ZTSTOP=1
I $D(^XTMP(NAMSPC,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,"STOP")
I ZTSTOP D
. S X=$G(^XTMP(NAMSPC,0,0))
. S $P(X,U,6)="STOPPED",$P(X,U,7)=$$NOW^XLFDT
. S ^XTMP(NAMSPC,0,0)=X
. Q
Q ZTSTOP
CHKSTAT(POST) ;check if job is running, stopped, or complete
N NAMSPC
S NAMSPC=$$NAMSPC
L +^XTMP(NAMSPC):1
I '$T Q 0
D KILIT
Q 1
;
;
KILIT ;
S:'$D(NAMSPC) NAMSPC=$$NAMSPC
I 'POST K ^XTMP(NAMSPC)
Q
NAMSPC() ;
Q $T(+0)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53659 4978 printed Nov 22, 2024@17:48:10 Page 2
DG53659 ;EG - DG*5.3*659 Cleanup Radiation Exposure; 08/08/2006
+1 ;;5.3;Registration;**659**;Aug 13,1993;Build 20
+2 ;
POST ;
+1 NEW U,ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK,ZTDTH
+2 SET U="^"
+3 DO BMES^XPDUTL("Queue-ing the job to reset Radiation Exposure Method...")
+4 SET ZTRTN="RUN^DG53659"
SET ZTDESC="Reset Radiation Exposure Method"
+5 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
DO ^%ZTLOAD
+6 DO BMES^XPDUTL("This request queued as Task # "_$GET(ZTSK))
+7 DO BMES^XPDUTL("=====================================================")
+8 DO BMES^XPDUTL("")
+9 QUIT
EP ; Queue the conversion
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("IEN12","RUN^DG53659(1)")
+3 ; Leave as last update
SET %=$$NEWCP^XPDUTL("END","END^DG53659")
+4 QUIT
+5 ;
END ; Post-install done
+1 DO BMES^XPDUTL("Post install complete.")
+2 QUIT
RUN ;entry point from taskman
+1 IF '$$CHKSTAT(1)
Begin DoDot:1
+2 DO BMES^XPDUTL("Conversion routine already running, process aborted")
+3 QUIT
End DoDot:1
QUIT
+4 NEW TESTING
+5 SET TESTING="N"
KILL ^TMP($$NAMSPC)
DO QUE
+6 QUIT
TEST ;entry point for test mode
+1 NEW TESTING,X,STARTID,ENDID,U,NAMSPC
+2 SET NAMSPC=$$NAMSPC
+3 SET TESTING="Y"
SET U="^"
+4 SET X=$$CHKSTAT(0)
+5 KILL ^XTMP(NAMSPC,"TEST RANGE"),^XTMP(NAMSPC,"TEST")
+6 SET STARTID=$$TESTID("Starting")
+7 SET ENDID=$$TESTID("Ending")
+8 IF ENDID<STARTID
USE 0
WRITE !,?10,"Ending IEN can't be less than starting IEN"
+9 SET ^XTMP(NAMSPC,"TEST RANGE")=STARTID_U_ENDID
+10 DO QUE
+11 QUIT
+12 ;
TESTID(MESS) ;
TESTIDG NEW X
+1 USE 0
WRITE !!,MESS," DFN for Patient file? "
READ X:300
+2 IF X=""
QUIT X
+3 IF X'?1N.N
IF X'?1N.N1"."1N.N
WRITE !,?10,"Must be numeric"
GOTO TESTIDG
+4 QUIT X
+5 ;
QUE ;
+1 NEW ZTSTOP,X,U,NAMSPC
+2 SET U="^"
+3 IF '$DATA(TESTING)
NEW TESTING
SET TESTING="N"
+4 SET NAMSPC=$$NAMSPC
+5 SET X=$$SETUPX(90)
+6 SET X=$GET(^XTMP(NAMSPC,0,0))
+7 SET $PIECE(X,U,6)="RUNNING"
+8 SET $PIECE(X,U,7)=$$NOW^XLFDT
+9 SET ^XTMP(NAMSPC,0,0)=X
+10 ;
+11 SET X=$$LOOP(NAMSPC,TESTING)
SET ZTSTOP=$PIECE(X,U,2)
+12 SET X=$GET(^XTMP(NAMSPC,0,0))
+13 SET $PIECE(X,U,6)=$SELECT(ZTSTOP:"STOPPED",1:"COMPLETED")
+14 SET $PIECE(X,U,8)=$$NOW^XLFDT
+15 SET ^XTMP(NAMSPC,0,0)=X
+16 ;
+17 SET X=$$MAIL^DG53659M(NAMSPC,TESTING,DUZ)
+18 KILL TESTING
+19 LOCK -^XTMP(NAMSPC)
+20 QUIT
+21 ;
SETUPX(EXPDAYS) ;
+1 ; requires EXPDAYS - number of days to keep XTMP around
+2 NEW BEGTIME,PURGDT,NAMSPC,U
+3 SET U="^"
+4 SET NAMSPC=$$NAMSPC
+5 SET BEGTIME=$$NOW^XLFDT()
+6 SET PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAYS)
+7 SET ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
+8 SET $PIECE(^XTMP(NAMSPC,0),U,3)="Convert Radiation Exposure Method"
+9 QUIT 1
+10 ;
LOOP(NAMSPC,TESTING) ;
+1 ;returns 0^stop flag
+2 NEW X,XREC,LASTREC,TOTREC,TOTPAT
+3 NEW U,ZTSTOP,REXP
+4 SET LASTREC=""
SET U="^"
SET ZTSTOP=0
+5 SET TOTREC=0
+6 IF $DATA(^XTMP(NAMSPC,0,0))
Begin DoDot:1
+7 SET XREC=$GET(^XTMP(NAMSPC,0,0))
+8 ;last DFN processed
+9 SET LASTREC=+$PIECE(XREC,U,1)
+10 ;total records read
+11 SET TOTREC=+$PIECE(XREC,U,2)
+12 SET TOTPAT=+$PIECE(XREC,U,10)
+13 QUIT
End DoDot:1
+14 DO DFN
+15 QUIT 0_"^"_ZTSTOP
+16 ;
DFN NEW DFN,END,X
+1 SET DFN=""
SET END=9999999999999999999999
+2 SET X=$GET(^XTMP(NAMSPC,"TEST RANGE"))
IF $LENGTH(X)
Begin DoDot:1
+3 SET DFN=$PIECE(X,U,1)-1
SET END=$PIECE(X,U,2)
+4 QUIT
End DoDot:1
+5 SET ZTSTOP=0
+6 FOR
SET DFN=$ORDER(^DPT(DFN))
if DFN=""!ZTSTOP!(DFN?1A.E)
QUIT
DO CHKR
+7 QUIT
+8 ;
CHKR NEW X,U,NEW
+1 SET U="^"
+2 IF DFN>END
SET ZTSTOP=2
QUIT
+3 SET LASTREC=DFN
+4 SET TOTREC=TOTREC+1
+5 IF (TOTREC#20)=0
SET ZTSTOP=$$STOP(NAMSPC)
IF ZTSTOP=1
QUIT
+6 SET X=$$CHPAT(DFN)
IF $PIECE(X,U,1)="Y"
Begin DoDot:1
+7 SET NEW=$PIECE(X,U,2)
SET TOTPAT=TOTPAT+1
+8 IF TESTING="N"
Begin DoDot:2
+9 NEW DA,DIE,DR,X
+10 SET DA=DFN
SET DIE="^DPT("
SET DR=".3212////"_NEW
+11 DO ^DIE
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 SET X=$$UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT)
+15 QUIT
CHPAT(DFN) ;
+1 NEW X,U,RET,VAL
+2 SET U="^"
SET RET="N"
+3 SET X=$GET(^DPT(DFN,.321))
+4 SET VAL=$PIECE(X,U,12)
+5 IF VAL?1N
IF VAL>1
IF VAL<8
QUIT RET
+6 IF $LENGTH(VAL)
Begin DoDot:1
+7 IF $PIECE($GET(^DPT(DFN,.321)),U,3)="Y"
SET RET="Y^"_$SELECT(VAL="N":2,VAL="T":3,VAL="B":4,1:3)
QUIT
+8 ;if radiation exposure indicated is set to 'No', delete radiation exposure method
+9 SET RET="Y^@"
+10 QUIT
End DoDot:1
+11 ;bulk fill to 3 if radiation exposure method is null
+12 ;and radiation exposure indicated is "Y"
+13 IF '$LENGTH(VAL)
IF $PIECE($GET(^DPT(DFN,.321)),U,3)="Y"
Begin DoDot:1
+14 SET RET="Y^3"
+15 QUIT
End DoDot:1
+16 QUIT RET
+17 ;
UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT) ;
+1 NEW X,U
+2 SET U="^"
SET X=$GET(^XTMP(NAMSPC,0,0))
+3 SET $PIECE(X,U,1)=$GET(LASTREC)
SET $PIECE(X,U,2)=$GET(TOTREC)
+4 SET $PIECE(X,U,10)=$GET(TOTPAT)
+5 SET ^XTMP(NAMSPC,0,0)=X
+6 QUIT 1
STATUS ;display status of current run
+1 NEW X,NAMSPC,U,OLD
+2 SET U="^"
+3 SET NAMSPC=$$NAMSPC
+4 SET X=$GET(^XTMP(NAMSPC,0,0))
+5 IF X=""
USE 0
WRITE !!,"Task not started!!!"
QUIT
+6 WRITE !!," Current status: ",$PIECE(X,U,6)
+7 WRITE !," Starting time: ",$$FMTE^XLFDT($PIECE(X,U,7))
+8 IF $PIECE(X,U,8)
Begin DoDot:1
+9 WRITE !," Ending time: ",$$FMTE^XLFDT($PIECE(X,U,8))
+10 QUIT
End DoDot:1
+11 WRITE !!," Total patient records read: ",$PIECE(X,U,2)
+12 WRITE !," Last patient record processed: ",$PIECE(X,U,1)
+13 WRITE !," Total patient records changed: ",$PIECE(X,U,10)
+14 QUIT
+15 ;
STOP(NAMSPC) ;
+1 NEW ZSTSTOP,U,X
+2 SET U="^"
+3 ;returns stop flag
+4 SET ZTSTOP=0
+5 IF $$S^%ZTLOAD
SET ZTSTOP=1
+6 IF $DATA(^XTMP(NAMSPC,"STOP"))
SET ZTSTOP=1
KILL ^XTMP(NAMSPC,"STOP")
+7 IF ZTSTOP
Begin DoDot:1
+8 SET X=$GET(^XTMP(NAMSPC,0,0))
+9 SET $PIECE(X,U,6)="STOPPED"
SET $PIECE(X,U,7)=$$NOW^XLFDT
+10 SET ^XTMP(NAMSPC,0,0)=X
+11 QUIT
End DoDot:1
+12 QUIT ZTSTOP
CHKSTAT(POST) ;check if job is running, stopped, or complete
+1 NEW NAMSPC
+2 SET NAMSPC=$$NAMSPC
+3 LOCK +^XTMP(NAMSPC):1
+4 IF '$TEST
QUIT 0
+5 DO KILIT
+6 QUIT 1
+7 ;
+8 ;
KILIT ;
+1 if '$DATA(NAMSPC)
SET NAMSPC=$$NAMSPC
+2 IF 'POST
KILL ^XTMP(NAMSPC)
+3 QUIT
NAMSPC() ;
+1 QUIT $TEXT(+0)
+2 ;
