- 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 Jan 18, 2025@03:38:16 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