DG53467P ; ALB/SCK - POST INSTALLATION ROUTINE DG*5.3*467 ; 8/6/2002
;;5.3;Registration;**467**;Aug 13, 1993
;
EN ; Main entry point for means test cleanup
;
I '$D(^XUSEC("DG MTDELETE",+DUZ)) W !!,">>> You must have the Means Test Delete key to run this cleanup!",$CHAR(7) Q
;
;; Check for XTMP global
I $D(^XTMP("DG467",0)) D
. Q:'$$CHECK
. D CLNUP
. I '$D(^XTMP("DG467")) D
. . W !!?3,"Cleanup complete, the ^XTMP global has been removed."
E D QUE
;
Q
;
QUE ; Que off a task to search for means test records with a missing status
N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO
;
W @IOF
W !!?3,"This will task off the search for Means Test records with a missing means"
W !?3,"test status. Re-running this entry point after completion of the search"
W !?3,"will initiate the cleanup process of these means test records."
;
S ZTRTN="BUILD^DG53467P"
S ZTDESC="SEARCH FOR MEANS TEST RECORDS WITH MISSING STATUS"
S ZTDTH="NOW"
S ZTIO=""
D ^%ZTLOAD
;
I $D(ZTSK)[0 W !!?5,"Search canceled!"
E W !!?5,"Search queued! [ ",ZTSK," ]"
D HOME^%ZIS
Q
;
BUILD ; Build list of means test records and store in temporary global
N MTIEN,MTNDE,ZNODE
;
S ^XTMP("DG467",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^MEANS TEST CLEANUP, PATCH DG*5.3*467"
;
S MTIEN=0
F S MTIEN=$O(^DGMT(408.31,MTIEN)) Q:'MTIEN D
. S MTNDE=$G(^DGMT(408.31,MTIEN,0))
. Q:$P(MTNDE,U,3)]"" ;; Null MT Status
. Q:$P(MTNDE,U,19)'=1 ;; Type of Test (MT = 1)
. S ^XTMP("DG467",1,MTIEN)=MTNDE
S ^XTMP("DG467",0,"END")=$H
Q
;
CHECK() ; Check for an existing XTMP global from a previous search. If one is found,
; continue processing means test records for deletion.
N DIR,RSLT,LASTDT,CNT,NDX,RTN,Y
;
I '$D(^XTMP("DG467",0,"END")) D Q 0
. W !!?3,">> The means test search for records with a missing status is still in"
. W !?3,">> progress. Please check back later."
;
I '$D(^XTMP("DG467",1)) D Q 0
. W !?3,">> The cleanup search was completed on "_$$FMTE^XLFDT($P(^XTMP("DG467",0),U,2))
. W !?3," There were no means test records found."
. S DIR(0)="YAO",DIR("B")="NO",DIR("A")="Do you wish to re-run the search? "
. D ^DIR K DIR
. I +Y K ^XTMP("DG467") D QUE
;
S LASTDT=$P(^XTMP("DG467",0),U,2)
S (CNT,NDX)=0
F S NDX=$O(^XTMP("DG467",1,NDX)) Q:'NDX S CNT=CNT+1
;
S DIR(0)="YAO",DIR("B")="YES"
S DIR("A",1)=CNT_" Means Test records with a missing means test status from a"
S DIR("A",2)="search on "_$S(LASTDT>0:$$FMTE^XLFDT(LASTDT),1:"")_" are available for processing."
S DIR("A")="Continue processing? "
S DIR("?")="HELP"
D ^DIR K DIR
I $D(DIRUT)!'Y Q 0
Q 1
;
CLNUP ; Process XTMP global means test records for deletion
N DIR,NDX,DIRUT,RSLT,Y
;
K ^TMP("DG467",$J)
;
S DIR(0)="YAO",DIR("B")="NO",DIR("A",1)=""
S DIR("A")="Do you wish to print out a list of the means test records? "
D ^DIR K DIR
I Y D PRINT
;
S DIR(0)="FAO",DIR("A")="Press any key to continue..."
D ^DIR K DIR
;
W @IOF
;; Begin loop through XTMP global
S NDX=0
F S NDX=$O(^XTMP("DG467",1,NDX)) Q:'NDX D Q:$D(DIRUT)
. D DISPLY(^XTMP("DG467",1,NDX),NDX)
. S DIR(0)="YAO",DIR("B")="YES",DIR("A")="Delete this means test record? "
. D ^DIR K DIR
. Q:$D(DIRUT)!('Y)
. S:$D(^DGMT(408.31,NDX,0)) ^TMP("DG467",$J,NDX,0)=^DGMT(408.31,NDX,0)
. S:$D(^DGMT(408.31,NDX,2)) ^TMP("DG467",$J,NDX,2)=^DGMT(408.31,NDX,2)
. S:$D(^DGMT(408.31,NDX,"PRIM")) ^TMP("DG467",$J,NDX,"PRIM")=^DGMT(408.31,NDX,"PRIM")
. S RSLT=$$EN^IVMCMD(NDX)
. I RSLT W !?5,">>> DELETED"
. E D
. . W !?5,"The deletion call was unable to remove record ",NDX
. . S DIR(0)="FAO",DIR("A")="Press any key to continue..."
. . D ^DIR K DIR
. . K ^TMP("DG467",$J,NDX)
. K ^XTMP("DG467",1,NDX)
;
D NOTIFY
;
I '$D(^XTMP("DG467",1)) D
. K ^XTMP("DG467")
Q
;
PRINT ; Print a report of the means test records found without a status
N DIR,ZTSAVE
;
W !!,"Report requires 132-col printer."
S ZTSAVE("DUZ")=""
D EN^XUTMDEVQ("REPORT^DG53467P","Missing Means Test Status Cleanup report",.ZTSAVE)
;
D HOME^%ZIS
Q
;
DISPLY(NODE0,MTIEN) ; Display the means test record being processed for deletion
N DFN,VA
;
W @IOF
S DFN=+$P(NODE0,U,2) D PID^VADPT6
W !?3,"Name : ",$$GET1^DIQ(2,DFN,.01)
W !?3,"SSN : ",VA("PID")
W !?3,"Date of Test : ",$$FMTE^XLFDT($P(NODE0,U,1))
W !?3,"Status : "
I +$P(NODE0,U,3)>0 W $$GET1^DIQ(408.32,$P(NODE0,U,3),.01)
W !?3,"Completed By : "
I +$P(NODE0,U,6)>0 W $$GET1^DIQ(2,$P(NODE0,U,6),.01)
W !?3,"Prim Inc Test for Yr : ",$$GET1^DIQ(408.31,NDX,2)
W !?3,"Test Determined Status : ",$$GET1^DIQ(408.32,+$$GET1^DIQ(408.31,NDX,2.03),.01)
W !?3,"Source of Income Test : "
I +$P(NODE0,U,23)>0 W $$GET1^DIQ(408.34,$P(NODE0,U,23),.01)
W !
Q
;
REPORT ; Print report of found MT records stored in the XTMP global
N PAGE,NDX,NODE,DFN,VA
;
S PAGE=1
D HDR
S NDX=0
F S NDX=$O(^XTMP("DG467",1,NDX)) Q:'NDX D
. S NODE=^XTMP("DG467",1,NDX)
. S DFN=+$P(NODE,U,2) D PID^VADPT6
. W !,$$GET1^DIQ(2,DFN,.01)
. W ?30,VA("BID")
. W ?40,$$FMTE^XLFDT($P(NODE,U,1))
. I +$P(NODE,U,6)>0 W ?56,$$GET1^DIQ(2,$P(NODE,U,6),.01)
. W ?85,$$GET1^DIQ(408.31,NDX,2)
. W ?98,$$GET1^DIQ(408.32,+$$GET1^DIQ(408.31,NDX,2.03),.01)
Q
;
HDR ; Print Report header
N DDASH
;
W "Report of Means Test Records with Missing Status not yet Processed"
W !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
W !,"Page ",PAGE
W !!?85,"Principle"
W !?30,"Last",?40,"Date",?85,"Inc. Test",?98,"Test-Determined"
W !,"Name",?30,"Four",?40,"of Test",?56,"Completed by",?85,"for Year",?98,"Status"
S $P(DDASH,"=",IOM)="" W !,DDASH
Q
;
NOTIFY ; Send notification message when clenup session is completed
N FNAME,PATH,XMSUB,XMTEXT,MSG,XMDUZ,NDX,POP,XMY,X,IO
;
;; Store off a copy of the MT records deleted this session
S X=$$NOW^XLFDT,FNAME=$P(X,".",1)_"_"_$P(X,".",2)_".TXT"
S PATH=$$PWD^%ZISH
;
D OPEN^%ZISH("FILE1",PATH,FNAME,"A")
I 'POP D
. U IO
. S NDX=0
. F S NDX=$O(^TMP("DG467",$J,NDX)) Q:'NDX D
. . W NDX_" | (0) "_$G(^TMP("DG467",$J,NDX,0)),!
. . W NDX_" | (2) "_$G(^TMP("DG467",$J,NDX,2)),!
. . W NDX_" | (PRIM) "_$G(^TMP("DG467",$J,NDX,"PRIM")),!
. D CLOSE^%ZISH("FILE1")
;
S MSG(1)="A partial copy of the Means Test records deleted through the"
S MSG(2)="Patch DG*5.3*467 cleanup session of "_$$FMTE^XLFDT($$NOW^XLFDT)
S MSG(3)="have been saved to the following file:"
S MSG(3.5)=""
S MSG(4)="Filename: "_FNAME
S MSG(5)=" Path: "_PATH
;
S XMSUB="Means Test Cleanup Results"
S XMY(DUZ)=""
S XMDUZ="DG53_467 MT Cleanup"
S XMTEXT="MSG("
D ^XMD
Q
;
QUERY ; Report query
N L,DIC,FLDS,BY,FR,TO,PG,DHD
;
S L=0
S DIC="^DGMT(408.31,"
S FLDS="NUMBER,.02,.01"
S BY=".03,.019,.23"
S FR="@,MEANS TEST,OTHER FACILITY"
S TO="@,MEANS TEST,OTHER FACILITY"
S PG=1
S DHD="Patients Missing a Means Test Status"
;
D EN1^DIP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53467P 7048 printed Dec 13, 2024@02:37:34 Page 2
DG53467P ; ALB/SCK - POST INSTALLATION ROUTINE DG*5.3*467 ; 8/6/2002
+1 ;;5.3;Registration;**467**;Aug 13, 1993
+2 ;
EN ; Main entry point for means test cleanup
+1 ;
+2 IF '$DATA(^XUSEC("DG MTDELETE",+DUZ))
WRITE !!,">>> You must have the Means Test Delete key to run this cleanup!",$CHAR(7)
QUIT
+3 ;
+4 ;; Check for XTMP global
+5 IF $DATA(^XTMP("DG467",0))
Begin DoDot:1
+6 if '$$CHECK
QUIT
+7 DO CLNUP
+8 IF '$DATA(^XTMP("DG467"))
Begin DoDot:2
+9 WRITE !!?3,"Cleanup complete, the ^XTMP global has been removed."
End DoDot:2
End DoDot:1
+10 IF '$TEST
DO QUE
+11 ;
+12 QUIT
+13 ;
QUE ; Que off a task to search for means test records with a missing status
+1 NEW ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED,ZTIO
+2 ;
+3 WRITE @IOF
+4 WRITE !!?3,"This will task off the search for Means Test records with a missing means"
+5 WRITE !?3,"test status. Re-running this entry point after completion of the search"
+6 WRITE !?3,"will initiate the cleanup process of these means test records."
+7 ;
+8 SET ZTRTN="BUILD^DG53467P"
+9 SET ZTDESC="SEARCH FOR MEANS TEST RECORDS WITH MISSING STATUS"
+10 SET ZTDTH="NOW"
+11 SET ZTIO=""
+12 DO ^%ZTLOAD
+13 ;
+14 IF $DATA(ZTSK)[0
WRITE !!?5,"Search canceled!"
+15 IF '$TEST
WRITE !!?5,"Search queued! [ ",ZTSK," ]"
+16 DO HOME^%ZIS
+17 QUIT
+18 ;
BUILD ; Build list of means test records and store in temporary global
+1 NEW MTIEN,MTNDE,ZNODE
+2 ;
+3 SET ^XTMP("DG467",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^MEANS TEST CLEANUP, PATCH DG*5.3*467"
+4 ;
+5 SET MTIEN=0
+6 FOR
SET MTIEN=$ORDER(^DGMT(408.31,MTIEN))
if 'MTIEN
QUIT
Begin DoDot:1
+7 SET MTNDE=$GET(^DGMT(408.31,MTIEN,0))
+8 ;; Null MT Status
if $PIECE(MTNDE,U,3)]""
QUIT
+9 ;; Type of Test (MT = 1)
if $PIECE(MTNDE,U,19)'=1
QUIT
+10 SET ^XTMP("DG467",1,MTIEN)=MTNDE
End DoDot:1
+11 SET ^XTMP("DG467",0,"END")=$HOROLOG
+12 QUIT
+13 ;
CHECK() ; Check for an existing XTMP global from a previous search. If one is found,
+1 ; continue processing means test records for deletion.
+2 NEW DIR,RSLT,LASTDT,CNT,NDX,RTN,Y
+3 ;
+4 IF '$DATA(^XTMP("DG467",0,"END"))
Begin DoDot:1
+5 WRITE !!?3,">> The means test search for records with a missing status is still in"
+6 WRITE !?3,">> progress. Please check back later."
End DoDot:1
QUIT 0
+7 ;
+8 IF '$DATA(^XTMP("DG467",1))
Begin DoDot:1
+9 WRITE !?3,">> The cleanup search was completed on "_$$FMTE^XLFDT($PIECE(^XTMP("DG467",0),U,2))
+10 WRITE !?3," There were no means test records found."
+11 SET DIR(0)="YAO"
SET DIR("B")="NO"
SET DIR("A")="Do you wish to re-run the search? "
+12 DO ^DIR
KILL DIR
+13 IF +Y
KILL ^XTMP("DG467")
DO QUE
End DoDot:1
QUIT 0
+14 ;
+15 SET LASTDT=$PIECE(^XTMP("DG467",0),U,2)
+16 SET (CNT,NDX)=0
+17 FOR
SET NDX=$ORDER(^XTMP("DG467",1,NDX))
if 'NDX
QUIT
SET CNT=CNT+1
+18 ;
+19 SET DIR(0)="YAO"
SET DIR("B")="YES"
+20 SET DIR("A",1)=CNT_" Means Test records with a missing means test status from a"
+21 SET DIR("A",2)="search on "_$SELECT(LASTDT>0:$$FMTE^XLFDT(LASTDT),1:"")_" are available for processing."
+22 SET DIR("A")="Continue processing? "
+23 SET DIR("?")="HELP"
+24 DO ^DIR
KILL DIR
+25 IF $DATA(DIRUT)!'Y
QUIT 0
+26 QUIT 1
+27 ;
CLNUP ; Process XTMP global means test records for deletion
+1 NEW DIR,NDX,DIRUT,RSLT,Y
+2 ;
+3 KILL ^TMP("DG467",$JOB)
+4 ;
+5 SET DIR(0)="YAO"
SET DIR("B")="NO"
SET DIR("A",1)=""
+6 SET DIR("A")="Do you wish to print out a list of the means test records? "
+7 DO ^DIR
KILL DIR
+8 IF Y
DO PRINT
+9 ;
+10 SET DIR(0)="FAO"
SET DIR("A")="Press any key to continue..."
+11 DO ^DIR
KILL DIR
+12 ;
+13 WRITE @IOF
+14 ;; Begin loop through XTMP global
+15 SET NDX=0
+16 FOR
SET NDX=$ORDER(^XTMP("DG467",1,NDX))
if 'NDX
QUIT
Begin DoDot:1
+17 DO DISPLY(^XTMP("DG467",1,NDX),NDX)
+18 SET DIR(0)="YAO"
SET DIR("B")="YES"
SET DIR("A")="Delete this means test record? "
+19 DO ^DIR
KILL DIR
+20 if $DATA(DIRUT)!('Y)
QUIT
+21 if $DATA(^DGMT(408.31,NDX,0))
SET ^TMP("DG467",$JOB,NDX,0)=^DGMT(408.31,NDX,0)
+22 if $DATA(^DGMT(408.31,NDX,2))
SET ^TMP("DG467",$JOB,NDX,2)=^DGMT(408.31,NDX,2)
+23 if $DATA(^DGMT(408.31,NDX,"PRIM"))
SET ^TMP("DG467",$JOB,NDX,"PRIM")=^DGMT(408.31,NDX,"PRIM")
+24 SET RSLT=$$EN^IVMCMD(NDX)
+25 IF RSLT
WRITE !?5,">>> DELETED"
+26 IF '$TEST
Begin DoDot:2
+27 WRITE !?5,"The deletion call was unable to remove record ",NDX
+28 SET DIR(0)="FAO"
SET DIR("A")="Press any key to continue..."
+29 DO ^DIR
KILL DIR
+30 KILL ^TMP("DG467",$JOB,NDX)
End DoDot:2
+31 KILL ^XTMP("DG467",1,NDX)
End DoDot:1
if $DATA(DIRUT)
QUIT
+32 ;
+33 DO NOTIFY
+34 ;
+35 IF '$DATA(^XTMP("DG467",1))
Begin DoDot:1
+36 KILL ^XTMP("DG467")
End DoDot:1
+37 QUIT
+38 ;
PRINT ; Print a report of the means test records found without a status
+1 NEW DIR,ZTSAVE
+2 ;
+3 WRITE !!,"Report requires 132-col printer."
+4 SET ZTSAVE("DUZ")=""
+5 DO EN^XUTMDEVQ("REPORT^DG53467P","Missing Means Test Status Cleanup report",.ZTSAVE)
+6 ;
+7 DO HOME^%ZIS
+8 QUIT
+9 ;
DISPLY(NODE0,MTIEN) ; Display the means test record being processed for deletion
+1 NEW DFN,VA
+2 ;
+3 WRITE @IOF
+4 SET DFN=+$PIECE(NODE0,U,2)
DO PID^VADPT6
+5 WRITE !?3,"Name : ",$$GET1^DIQ(2,DFN,.01)
+6 WRITE !?3,"SSN : ",VA("PID")
+7 WRITE !?3,"Date of Test : ",$$FMTE^XLFDT($PIECE(NODE0,U,1))
+8 WRITE !?3,"Status : "
+9 IF +$PIECE(NODE0,U,3)>0
WRITE $$GET1^DIQ(408.32,$PIECE(NODE0,U,3),.01)
+10 WRITE !?3,"Completed By : "
+11 IF +$PIECE(NODE0,U,6)>0
WRITE $$GET1^DIQ(2,$PIECE(NODE0,U,6),.01)
+12 WRITE !?3,"Prim Inc Test for Yr : ",$$GET1^DIQ(408.31,NDX,2)
+13 WRITE !?3,"Test Determined Status : ",$$GET1^DIQ(408.32,+$$GET1^DIQ(408.31,NDX,2.03),.01)
+14 WRITE !?3,"Source of Income Test : "
+15 IF +$PIECE(NODE0,U,23)>0
WRITE $$GET1^DIQ(408.34,$PIECE(NODE0,U,23),.01)
+16 WRITE !
+17 QUIT
+18 ;
REPORT ; Print report of found MT records stored in the XTMP global
+1 NEW PAGE,NDX,NODE,DFN,VA
+2 ;
+3 SET PAGE=1
+4 DO HDR
+5 SET NDX=0
+6 FOR
SET NDX=$ORDER(^XTMP("DG467",1,NDX))
if 'NDX
QUIT
Begin DoDot:1
+7 SET NODE=^XTMP("DG467",1,NDX)
+8 SET DFN=+$PIECE(NODE,U,2)
DO PID^VADPT6
+9 WRITE !,$$GET1^DIQ(2,DFN,.01)
+10 WRITE ?30,VA("BID")
+11 WRITE ?40,$$FMTE^XLFDT($PIECE(NODE,U,1))
+12 IF +$PIECE(NODE,U,6)>0
WRITE ?56,$$GET1^DIQ(2,$PIECE(NODE,U,6),.01)
+13 WRITE ?85,$$GET1^DIQ(408.31,NDX,2)
+14 WRITE ?98,$$GET1^DIQ(408.32,+$$GET1^DIQ(408.31,NDX,2.03),.01)
End DoDot:1
+15 QUIT
+16 ;
HDR ; Print Report header
+1 NEW DDASH
+2 ;
+3 WRITE "Report of Means Test Records with Missing Status not yet Processed"
+4 WRITE !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
+5 WRITE !,"Page ",PAGE
+6 WRITE !!?85,"Principle"
+7 WRITE !?30,"Last",?40,"Date",?85,"Inc. Test",?98,"Test-Determined"
+8 WRITE !,"Name",?30,"Four",?40,"of Test",?56,"Completed by",?85,"for Year",?98,"Status"
+9 SET $PIECE(DDASH,"=",IOM)=""
WRITE !,DDASH
+10 QUIT
+11 ;
NOTIFY ; Send notification message when clenup session is completed
+1 NEW FNAME,PATH,XMSUB,XMTEXT,MSG,XMDUZ,NDX,POP,XMY,X,IO
+2 ;
+3 ;; Store off a copy of the MT records deleted this session
+4 SET X=$$NOW^XLFDT
SET FNAME=$PIECE(X,".",1)_"_"_$PIECE(X,".",2)_".TXT"
+5 SET PATH=$$PWD^%ZISH
+6 ;
+7 DO OPEN^%ZISH("FILE1",PATH,FNAME,"A")
+8 IF 'POP
Begin DoDot:1
+9 USE IO
+10 SET NDX=0
+11 FOR
SET NDX=$ORDER(^TMP("DG467",$JOB,NDX))
if 'NDX
QUIT
Begin DoDot:2
+12 WRITE NDX_" | (0) "_$GET(^TMP("DG467",$JOB,NDX,0)),!
+13 WRITE NDX_" | (2) "_$GET(^TMP("DG467",$JOB,NDX,2)),!
+14 WRITE NDX_" | (PRIM) "_$GET(^TMP("DG467",$JOB,NDX,"PRIM")),!
End DoDot:2
+15 DO CLOSE^%ZISH("FILE1")
End DoDot:1
+16 ;
+17 SET MSG(1)="A partial copy of the Means Test records deleted through the"
+18 SET MSG(2)="Patch DG*5.3*467 cleanup session of "_$$FMTE^XLFDT($$NOW^XLFDT)
+19 SET MSG(3)="have been saved to the following file:"
+20 SET MSG(3.5)=""
+21 SET MSG(4)="Filename: "_FNAME
+22 SET MSG(5)=" Path: "_PATH
+23 ;
+24 SET XMSUB="Means Test Cleanup Results"
+25 SET XMY(DUZ)=""
+26 SET XMDUZ="DG53_467 MT Cleanup"
+27 SET XMTEXT="MSG("
+28 DO ^XMD
+29 QUIT
+30 ;
QUERY ; Report query
+1 NEW L,DIC,FLDS,BY,FR,TO,PG,DHD
+2 ;
+3 SET L=0
+4 SET DIC="^DGMT(408.31,"
+5 SET FLDS="NUMBER,.02,.01"
+6 SET BY=".03,.019,.23"
+7 SET FR="@,MEANS TEST,OTHER FACILITY"
+8 SET TO="@,MEANS TEST,OTHER FACILITY"
+9 SET PG=1
+10 SET DHD="Patients Missing a Means Test Status"
+11 ;
+12 DO EN1^DIP
+13 QUIT
