Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53467P

DG53467P.m

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