source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53467P.m@ 918

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