DG53742 ;ALB/TMK - DG*5.3*764 (formerly 742) Cleanup OEF/OIF site info; 01/10/2007
;;5.3;Registration;**764**;Aug 13,1993;Build 16
;
POST ; This routine was previously part of patch DG*5.3*742, now in *764
N ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK,ZTDTH
D BMES^XPDUTL("Queue-ing the job to correct OEF/OIF site info...")
K ^XTMP($$NAMSPC)
S ZTRTN="RUN^DG53742",ZTDESC="Correct OEF/OIF site info"
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("POST","POST^DG53742")
S %=$$NEWCP^XPDUTL("EVC1","EVC1^DG53742")
S %=$$NEWCP^XPDUTL("END","END^DG53742") ; Leave as last update
Q
;
EVC1 ; Update the USE FOR Z07 CHECK field #6
; in the INCONSISTENT DATA ELEMENTS file #38.6 for CC 718
N RULE,DA,DIE,DR,X,Y
S RULE=718
D BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")
S DIE=38.6,DA=$$FIND1^DIC(DIE,"","X",RULE)
I 'DA D Q
.D MES^XPDUTL(" *** Entry not found! Nothing Updated!! ***") Q
S DR="6////0" D ^DIE
D MES^XPDUTL(" *** Update Complete ***")
D BMES^XPDUTL("")
Q
;
END ; Post-install done
D BMES^XPDUTL("Post install complete.")
Q
;
RUN ; 'Live' entry point from taskman
N NAMSPC
S NAMSPC=$$NAMSPC
D QUE(NAMSPC,0)
Q
;
TEST ;entry point for test mode
N NAMSPC
S NAMSPC=$$NAMSPC_"_TEST"
D QUE(NAMSPC,1)
Q
;
QUE(NAMSPC,TESTING) ;
N ZTSTOP,DGX,X,Y
S TESTING=+$G(TESTING)
D SETUPX(NAMSPC,90)
S DGX=$G(^XTMP(NAMSPC,0,0))
I $P(DGX,U,6)="COMPLETED" D MAIL(NAMSPC,TESTING) Q
S $P(DGX,U,6)="RUNNING"
S $P(DGX,U,7)=$$NOW^XLFDT
S ^XTMP(NAMSPC,0,0)=DGX
;
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
;
D MAIL(NAMSPC,TESTING)
Q
;
SETUPX(NAMSPC,EXPDAYS) ;
; requires EXPDAYS - # days to keep XTMP around
N BEGTIME,PURGDT
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)="Correct OEF/OIF site info"
Q
;
LOOP(NAMSPC,TESTING) ;
;returns 0^stop flag
N X,XREC,LASTREC,TOTREC,TOTPAT
S LASTREC="",ZTSTOP=0
S TOTREC=0
I $D(^XTMP(NAMSPC,0,0)) D
. S XREC=$G(^XTMP(NAMSPC,0,0))
. ;last xref entry processed
. S LASTREC=$P(XREC,U,1)
. ;total records read
. S TOTREC=+$P(XREC,U,2)
. ; total OEIF records updated
. S TOTPAT=+$P(XREC,U,10)
. Q
D OEIF(NAMSPC,TESTING,LASTREC)
Q 0_"^"_ZTSTOP
;
OEIF(NAMSPC,TESTING,LASTREC) ;
N GBL,DFN,OEIF,SITE,X,Y,Z,DIE,DR,DA
S ZTSTOP=0
S GBL="^DPT(""ALOEIF"""
I $TR(LASTREC,";")'="" D
. F Z=1:1:5 Q:$P(LASTREC,";",Z)="" S:Z=1 GBL=GBL_"," S GBL=GBL_""""_$P(LASTREC,";",Z)_""""_$S($P(LASTREC,";",Z+1)'="":",",1:"")
S GBL=GBL_")"
F S GBL=$Q(@GBL) Q:GBL=""!($QS(GBL,1)'="ALOEIF")!ZTSTOP S DFN=$QS(GBL,5) I DFN D
. S OEIF=0 F S OEIF=$O(^DPT(DFN,.3215,OEIF)) Q:'OEIF S SITE=$P($G(^(OEIF,0)),U,6) I SITE,+SITE'=SITE S SITE=+$O(^DIC(4,"D",SITE,0)) I SITE D
.. S DR=".06////"_SITE,DA(1)=DFN,DA=OEIF,DIE="^DPT("_DA(1)_",.3215," D:'TESTING ^DIE S TOTPAT=TOTPAT+1
. S ZTSTOP=$$CHKR(NAMSPC,TESTING,GBL,TOTPAT,.TOTREC)
Q
;
CHKR(NAMSPC,TESTING,GBL,TOTPAT,TOTREC) ;
N X,Z,ZTSTOP
S ZTSTOP=0
F Z=2:1:6 S LASTREC=$QS(GBL,Z)_";"
S TOTREC=TOTREC+1
D UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT)
I '(TOTREC#500) S ZTSTOP=$$STOP(NAMSPC)
Q ZTSTOP
;
UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT) ;
N X
S 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
;
STATUS ;display status of current run
N DIR,X,Y,DTOUT,DUOUT,NAMSPC
S DIR(0)="SA^T:TEST;L:LIVE",DIR("A")="(T)EST OR (L)IVE?: ",DIR("B")="LIVE"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)
S NAMSPC=$$NAMSPC_$S(Y="L":"",1:"_TEST")
I Y'="L" W !,"TEST TEST TEST TEST TEST TEST",!
S X=$G(^XTMP(NAMSPC,0,0))
I X="" 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) W !," Ending time: ",$$FMTE^XLFDT($P(X,U,8))
W !!," Total patient records read: ",$P(X,U,2)
W !," Last patient record processed: ",$P(X,U,1)
W !," Total OEF/OIF records changed: ",$P(X,U,10)
Q
;
STOP(NAMSPC) ; returns stop flag
N ZTSTOP,X
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
;
NAMSPC() ;
Q $T(+0)
;
MAIL(NAMSPC,TESTING) ; mail stats
N MSGNO,TOTREC,TOTPAT,STAT,STIME,ETIME,LIN,HTEXT,X
S X=$G(^XTMP(NAMSPC,0,0))
S TOTREC=$P(X,U,2)
S STAT=$P(X,U,6),STIME=$P(X,U,7)
S ETIME=$P(X,U,8)
S TOTPAT=$P(X,U,10)
;
D HDNG(NAMSPC,.HTEXT,.LIN,STAT,STIME,ETIME,TESTING)
D SUMRY(.LIN,TOTREC,TOTPAT)
D MAILIT(HTEXT,NAMSPC)
K ^TMP(NAMSPC,$J,"MSG")
Q
;
HDNG(NAMSPC,HTEXT,LIN,STAT,STIME,ETIME,TESTING) ; build heading lines
N X,Y,TEXT
K ^TMP(NAMSPC,$J,"MSG")
S LIN=0
S HTEXT="Correct OEF/OIF site info "_STAT_" on "
S HTEXT=HTEXT_$$FMTE^XLFDT(ETIME)
D BLDLINE(NAMSPC,HTEXT,.LIN)
D BLDLINE(NAMSPC,"",.LIN)
I TESTING D
. S TEXT="** TESTING - NO CHANGES TO DATABASE EXECUTED **"
. D BLDLINE(NAMSPC,TEXT,.LIN)
D BLDLINE(NAMSPC,"",.LIN)
Q
;
SUMRY(LIN,TOTREC,TOTPAT) ; build summary lines
N TEXT
S TEXT=" Total Patient Records Read: "_$J($FN(TOTREC,","),11)
D BLDLINE(NAMSPC,TEXT,.LIN)
S TEXT=" Total OEF/OIF Records Changed: "_$J($FN(TOTPAT,","),11)
D BLDLINE(NAMSPC,TEXT,.LIN)
Q
;
BLDLINE(NAMSPC,TEXT,LIN) ;build a single line in TMP msg global
S LIN=LIN+1
S ^TMP(NAMSPC,$J,"MSG",LIN)=TEXT
Q
;
MAILIT(HTEXT,NAMSPC) ; send the msg
N XMY,XMDUZ,XMSUB,XMTEXT
S XMY(DUZ)="",XMDUZ=.5
S XMY("G.DGEN ELIGIBILITY ALERT")=""
S XMSUB=HTEXT
S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
D ^XMD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53742 6061 printed Sep 23, 2025@20:14:29 Page 2
DG53742 ;ALB/TMK - DG*5.3*764 (formerly 742) Cleanup OEF/OIF site info; 01/10/2007
+1 ;;5.3;Registration;**764**;Aug 13,1993;Build 16
+2 ;
POST ; This routine was previously part of patch DG*5.3*742, now in *764
+1 NEW ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK,ZTDTH
+2 DO BMES^XPDUTL("Queue-ing the job to correct OEF/OIF site info...")
+3 KILL ^XTMP($$NAMSPC)
+4 SET ZTRTN="RUN^DG53742"
SET ZTDESC="Correct OEF/OIF site info"
+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("POST","POST^DG53742")
+3 SET %=$$NEWCP^XPDUTL("EVC1","EVC1^DG53742")
+4 ; Leave as last update
SET %=$$NEWCP^XPDUTL("END","END^DG53742")
+5 QUIT
+6 ;
EVC1 ; Update the USE FOR Z07 CHECK field #6
+1 ; in the INCONSISTENT DATA ELEMENTS file #38.6 for CC 718
+2 NEW RULE,DA,DIE,DR,X,Y
+3 SET RULE=718
+4 DO BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")
+5 SET DIE=38.6
SET DA=$$FIND1^DIC(DIE,"","X",RULE)
+6 IF 'DA
Begin DoDot:1
+7 DO MES^XPDUTL(" *** Entry not found! Nothing Updated!! ***")
QUIT
End DoDot:1
QUIT
+8 SET DR="6////0"
DO ^DIE
+9 DO MES^XPDUTL(" *** Update Complete ***")
+10 DO BMES^XPDUTL("")
+11 QUIT
+12 ;
END ; Post-install done
+1 DO BMES^XPDUTL("Post install complete.")
+2 QUIT
+3 ;
RUN ; 'Live' entry point from taskman
+1 NEW NAMSPC
+2 SET NAMSPC=$$NAMSPC
+3 DO QUE(NAMSPC,0)
+4 QUIT
+5 ;
TEST ;entry point for test mode
+1 NEW NAMSPC
+2 SET NAMSPC=$$NAMSPC_"_TEST"
+3 DO QUE(NAMSPC,1)
+4 QUIT
+5 ;
QUE(NAMSPC,TESTING) ;
+1 NEW ZTSTOP,DGX,X,Y
+2 SET TESTING=+$GET(TESTING)
+3 DO SETUPX(NAMSPC,90)
+4 SET DGX=$GET(^XTMP(NAMSPC,0,0))
+5 IF $PIECE(DGX,U,6)="COMPLETED"
DO MAIL(NAMSPC,TESTING)
QUIT
+6 SET $PIECE(DGX,U,6)="RUNNING"
+7 SET $PIECE(DGX,U,7)=$$NOW^XLFDT
+8 SET ^XTMP(NAMSPC,0,0)=DGX
+9 ;
+10 SET X=$$LOOP(NAMSPC,TESTING)
SET ZTSTOP=$PIECE(X,U,2)
+11 SET X=$GET(^XTMP(NAMSPC,0,0))
+12 SET $PIECE(X,U,6)=$SELECT(ZTSTOP:"STOPPED",1:"COMPLETED")
+13 SET $PIECE(X,U,8)=$$NOW^XLFDT
+14 SET ^XTMP(NAMSPC,0,0)=X
+15 ;
+16 DO MAIL(NAMSPC,TESTING)
+17 QUIT
+18 ;
SETUPX(NAMSPC,EXPDAYS) ;
+1 ; requires EXPDAYS - # days to keep XTMP around
+2 NEW BEGTIME,PURGDT
+3 SET NAMSPC=$$NAMSPC
+4 SET BEGTIME=$$NOW^XLFDT()
+5 SET PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAYS)
+6 SET ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
+7 SET $PIECE(^XTMP(NAMSPC,0),U,3)="Correct OEF/OIF site info"
+8 QUIT
+9 ;
LOOP(NAMSPC,TESTING) ;
+1 ;returns 0^stop flag
+2 NEW X,XREC,LASTREC,TOTREC,TOTPAT
+3 SET LASTREC=""
SET ZTSTOP=0
+4 SET TOTREC=0
+5 IF $DATA(^XTMP(NAMSPC,0,0))
Begin DoDot:1
+6 SET XREC=$GET(^XTMP(NAMSPC,0,0))
+7 ;last xref entry processed
+8 SET LASTREC=$PIECE(XREC,U,1)
+9 ;total records read
+10 SET TOTREC=+$PIECE(XREC,U,2)
+11 ; total OEIF records updated
+12 SET TOTPAT=+$PIECE(XREC,U,10)
+13 QUIT
End DoDot:1
+14 DO OEIF(NAMSPC,TESTING,LASTREC)
+15 QUIT 0_"^"_ZTSTOP
+16 ;
OEIF(NAMSPC,TESTING,LASTREC) ;
+1 NEW GBL,DFN,OEIF,SITE,X,Y,Z,DIE,DR,DA
+2 SET ZTSTOP=0
+3 SET GBL="^DPT(""ALOEIF"""
+4 IF $TRANSLATE(LASTREC,";")'=""
Begin DoDot:1
+5 FOR Z=1:1:5
if $PIECE(LASTREC,";",Z)=""
QUIT
if Z=1
SET GBL=GBL_","
SET GBL=GBL_""""_$PIECE(LASTREC,";",Z)_""""_$SELECT($PIECE(LASTREC,";",Z+1)'="":",",1:"")
End DoDot:1
+6 SET GBL=GBL_")"
+7 FOR
SET GBL=$QUERY(@GBL)
if GBL=""!($QSUBSCRIPT(GBL,1)'="ALOEIF")!ZTSTOP
QUIT
SET DFN=$QSUBSCRIPT(GBL,5)
IF DFN
Begin DoDot:1
+8 SET OEIF=0
FOR
SET OEIF=$ORDER(^DPT(DFN,.3215,OEIF))
if 'OEIF
QUIT
SET SITE=$PIECE($GET(^(OEIF,0)),U,6)
IF SITE
IF +SITE'=SITE
SET SITE=+$ORDER(^DIC(4,"D",SITE,0))
IF SITE
Begin DoDot:2
+9 SET DR=".06////"_SITE
SET DA(1)=DFN
SET DA=OEIF
SET DIE="^DPT("_DA(1)_",.3215,"
if 'TESTING
DO ^DIE
SET TOTPAT=TOTPAT+1
End DoDot:2
+10 SET ZTSTOP=$$CHKR(NAMSPC,TESTING,GBL,TOTPAT,.TOTREC)
End DoDot:1
+11 QUIT
+12 ;
CHKR(NAMSPC,TESTING,GBL,TOTPAT,TOTREC) ;
+1 NEW X,Z,ZTSTOP
+2 SET ZTSTOP=0
+3 FOR Z=2:1:6
SET LASTREC=$QSUBSCRIPT(GBL,Z)_";"
+4 SET TOTREC=TOTREC+1
+5 DO UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT)
+6 IF '(TOTREC#500)
SET ZTSTOP=$$STOP(NAMSPC)
+7 QUIT ZTSTOP
+8 ;
UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT) ;
+1 NEW X
+2 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
+7 ;
STATUS ;display status of current run
+1 NEW DIR,X,Y,DTOUT,DUOUT,NAMSPC
+2 SET DIR(0)="SA^T:TEST;L:LIVE"
SET DIR("A")="(T)EST OR (L)IVE?: "
SET DIR("B")="LIVE"
+3 DO ^DIR
KILL DIR
+4 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+5 SET NAMSPC=$$NAMSPC_$S(Y="L":"",1:"_TEST")
+6 IF Y'="L"
WRITE !,"TEST TEST TEST TEST TEST TEST",!
+7 SET X=$GET(^XTMP(NAMSPC,0,0))
+8 IF X=""
WRITE !!,"Task not started!!!"
QUIT
+9 WRITE !!," Current status: ",$PIECE(X,U,6)
+10 WRITE !," Starting time: ",$$FMTE^XLFDT($PIECE(X,U,7))
+11 IF $PIECE(X,U,8)
WRITE !," Ending time: ",$$FMTE^XLFDT($PIECE(X,U,8))
+12 WRITE !!," Total patient records read: ",$PIECE(X,U,2)
+13 WRITE !," Last patient record processed: ",$PIECE(X,U,1)
+14 WRITE !," Total OEF/OIF records changed: ",$PIECE(X,U,10)
+15 QUIT
+16 ;
STOP(NAMSPC) ; returns stop flag
+1 NEW ZTSTOP,X
+2 SET ZTSTOP=0
+3 IF $$S^%ZTLOAD
SET ZTSTOP=1
+4 IF $DATA(^XTMP(NAMSPC,"STOP"))
SET ZTSTOP=1
KILL ^XTMP(NAMSPC,"STOP")
+5 IF ZTSTOP
Begin DoDot:1
+6 SET X=$GET(^XTMP(NAMSPC,0,0))
+7 SET $PIECE(X,U,6)="STOPPED"
SET $PIECE(X,U,7)=$$NOW^XLFDT
+8 SET ^XTMP(NAMSPC,0,0)=X
+9 QUIT
End DoDot:1
+10 QUIT ZTSTOP
+11 ;
NAMSPC() ;
+1 QUIT $TEXT(+0)
+2 ;
MAIL(NAMSPC,TESTING) ; mail stats
+1 NEW MSGNO,TOTREC,TOTPAT,STAT,STIME,ETIME,LIN,HTEXT,X
+2 SET X=$GET(^XTMP(NAMSPC,0,0))
+3 SET TOTREC=$PIECE(X,U,2)
+4 SET STAT=$PIECE(X,U,6)
SET STIME=$PIECE(X,U,7)
+5 SET ETIME=$PIECE(X,U,8)
+6 SET TOTPAT=$PIECE(X,U,10)
+7 ;
+8 DO HDNG(NAMSPC,.HTEXT,.LIN,STAT,STIME,ETIME,TESTING)
+9 DO SUMRY(.LIN,TOTREC,TOTPAT)
+10 DO MAILIT(HTEXT,NAMSPC)
+11 KILL ^TMP(NAMSPC,$JOB,"MSG")
+12 QUIT
+13 ;
HDNG(NAMSPC,HTEXT,LIN,STAT,STIME,ETIME,TESTING) ; build heading lines
+1 NEW X,Y,TEXT
+2 KILL ^TMP(NAMSPC,$JOB,"MSG")
+3 SET LIN=0
+4 SET HTEXT="Correct OEF/OIF site info "_STAT_" on "
+5 SET HTEXT=HTEXT_$$FMTE^XLFDT(ETIME)
+6 DO BLDLINE(NAMSPC,HTEXT,.LIN)
+7 DO BLDLINE(NAMSPC,"",.LIN)
+8 IF TESTING
Begin DoDot:1
+9 SET TEXT="** TESTING - NO CHANGES TO DATABASE EXECUTED **"
+10 DO BLDLINE(NAMSPC,TEXT,.LIN)
End DoDot:1
+11 DO BLDLINE(NAMSPC,"",.LIN)
+12 QUIT
+13 ;
SUMRY(LIN,TOTREC,TOTPAT) ; build summary lines
+1 NEW TEXT
+2 SET TEXT=" Total Patient Records Read: "_$JUSTIFY($FNUMBER(TOTREC,","),11)
+3 DO BLDLINE(NAMSPC,TEXT,.LIN)
+4 SET TEXT=" Total OEF/OIF Records Changed: "_$JUSTIFY($FNUMBER(TOTPAT,","),11)
+5 DO BLDLINE(NAMSPC,TEXT,.LIN)
+6 QUIT
+7 ;
BLDLINE(NAMSPC,TEXT,LIN) ;build a single line in TMP msg global
+1 SET LIN=LIN+1
+2 SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=TEXT
+3 QUIT
+4 ;
MAILIT(HTEXT,NAMSPC) ; send the msg
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMY("G.DGEN ELIGIBILITY ALERT")=""
+4 SET XMSUB=HTEXT
+5 SET XMTEXT="^TMP(NAMSPC,$J,""MSG"","
+6 DO ^XMD
+7 QUIT
+8 ;
