221 lines
6.7 KiB
Mathematica
221 lines
6.7 KiB
Mathematica
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
|