DG53426M ;ALB/AEG - DG*5.3*426 POST INSTALLATION ; 2-21-02
;;5.3;Registration;**426,1015**;2-21-02;Build 21
;
CAT1A ; Generate mail message if no records exist to be cleaned up.
I '$D(^TMP($J,"CAT 1a")) D
.S ^UTILITY($J,1)="No patients on file with a Means Test status of 'REQUIRED' who have"
.S ^UTILITY($J,2)="a previous test in either a Cat C or PENDING ADJUDICATION status,"
.S ^UTILITY($J,3)="Agreed to pay deductible field is 'YES', and the date of test"
.S ^UTILITY($J,4)="is after 10/5/1999. No action required or taken."
.N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
.S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
.S XMTEXT="^UTILITY($J,",XMSUB="DG*5.3*426 POST INSTALL REPORT #1"
.D ^XMD
.D MM^DG53426U(XMZ)
.K ^UTILITY($J)
Q
CAT1AP ; Purged Record Report.
N DFN,IEN,NODE0,I
S (DFN,IEN,NODE0)=""
I $D(^TMP("P-REQ",$J)) D
.S ^UTILITY($J,1)="The following 'REQUIRED' status Means Test records have"
.S ^UTILITY($J,2)="been purged from your database. These records were purged"
.S ^UTILITY($J,3)="due to the patient having a Means Test meeting the criteria"
.S ^UTILITY($J,4)="introduced in patch DG*5.3*326. The criteria are as follows:"
.S ^UTILITY($J,5)=" "
.S ^UTILITY($J,6)=" 1 - Means Test status is Category C or Pending Adjudication."
.S ^UTILITY($J,7)=" 2 - The date of the test is on or after 10/6/1999."
.S ^UTILITY($J,8)=" 3 - Agreed to Pay deductible field value is 'YES'."
.S ^UTILITY($J,9)=" "
.S ^UTILITY($J,10)=$$BLDSTR("PATIENT NAME","SSN"," ","PURGED TEST DATE")
.S ^UTILITY($J,11)=$$BLDSTR("------------","---"," ","-------------")
.F I=12:1 S DFN=$O(^TMP("P-REQ",$J,DFN)) Q:'DFN D
..N DFN1,MTIEN1,TDATE,PID,PNAME,TDATE1
..S DFN1=$P($G(DFN),"~~",1),MTIEN1=$P($G(DFN),"~~",2)
..S NODE0=$G(^TMP("P-REQ",$J,DFN)),TDATE=$P(NODE0,U,1)
..S Y=TDATE X ^DD("DD") S TDATE1=Y
..S PNAME=$P($G(^DPT(DFN1,0)),U,1)
..S PID=$E($P($G(^DPT(DFN1,0)),U,9),1,3)_"-"_$E($P($G(^DPT(DFN1,0)),U,9),4,5)_"-"_$E($P($G(^DPT(DFN1,0)),U,9),6,9)
..S ^UTILITY($J,I)=$$BLDSTR(PNAME,PID," ",TDATE1)
.Q
I $D(^UTILITY($J)) D
.N DIFROM,%,Y,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
.S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
.S XMTEXT="^UTILITY($J,",XMSUB="DG*5.3*426 POST INSTALL REPORT #1"
.D ^XMD
.D MM^DG53426U(XMZ)
K ^UTILITY($J),^TMP("P-REQ"),^TMP($J,"CAT 1a")
Q
;
CAT1B ; Report to site that no required status tests on file requiring action.
I '$D(^TMP($J,"CAT 1b")) D
.S ^UTILITY($J,1)="No patients on file with a Means Test status of 'REQUIRED' who do not"
.S ^UTILITY($J,2)="meet the search criteria of patch DG*5.3*426."
.N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
.S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
.S XMTEXT="^UTILITY($J,",XMSUB="DG*5.3*426 POST INSTALL REPORT #2"
.D ^XMD
.D MM^DG53426U(XMZ)
.K ^UTILITY($J)
Q
CAT1BR ; Report to the site any record in a 'REQUIRED' status needing
; action.
I $D(^TMP($J,"CAT 1b")) D
.N DFN,IEN,NODE0
.S (DFN,IEN,NODE0)=""
.S ^UTILITY($J,1)="The following Means Tests in your database are in a 'REQUIRED'"
.S ^UTILITY($J,2)="status. The historical records do not meet the criteria for"
.S ^UTILITY($J,3)="cleanup by patch DG*5.3*426. Please update these records."
.S ^UTILITY($J,4)=" "
.S ^UTILITY($J,5)=$$BLDSTR("PATIENT NAME","SSN"," ","**TEST DATE**")
.S ^UTILITY($J,6)=$$BLDSTR("------------","---"," ","-------------")
.N PID,PNAME,LST,DGMTDT,DGMTDT1
.F I=7:1 S DFN=$O(^TMP($J,"CAT 1b",DFN)) Q:'DFN D
..S PNAME=$P($G(^DPT(DFN,0)),U,1)
..S PID=$E($P($G(^DPT(DFN,0)),U,9),1,3)_"-"_$E($P($G(^DPT(DFN,0)),U,9),4,5)_"-"_$E($P($G(^DPT(DFN,0)),U,9),6,9)
..S LST=$$LST^DGMTU(DFN),DGMTDT=$P(LST,U,2)
..S Y=DGMTDT X ^DD("DD") S DGMTDT1=Y
..S ^UTILITY($J,I)=$$BLDSTR(PNAME,PID," ",DGMTDT1)
..Q
.Q
I $D(^UTILITY($J)) D
.N DIFROM,%,Y,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
.S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
.S XMTEXT="^UTILITY($J,",XMSUB="DG*5.3*426 POST INSTALL REPORT #2"
.D ^XMD
.D MM^DG53426U(XMZ)
K ^UTILITY($J),^TMP($J,"CAT 1b")
Q
NOCAT2 ; report no cat Cs who declined to give income info but agree to pay
I '$D(^TMP($J,"CAT 2")) D
.S ^UTILITY($J,1)="No patients on file with a Means Test status of 'REQUIRED' who have"
.S ^UTILITY($J,2)="a Category C status test in which the patient declined to give"
.S ^UTILITY($J,3)="income information but agreed to pay the deductible."
.N DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
.S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
.S XMSUB="DG*5.3*426 POST INSTALL REPORT #3",XMTEXT="^UTILITY($J,"
.D ^XMD
.D MM^DG53426U(XMZ)
.K ^UTILITY($J)
Q
;
BLDSTR(P1,P2,P3,P4) ; Build a string from input
N S1,S2,S3,S4
S S1=$E(P1,1,15) I $L(S1)'>14 D
.S S1=S1_$J("",(15-$L(S1)))
S S2=P2
S S3=P3
S S4=P4
Q S1_$J("",5)_S2_$J("",5)_S3_$J("",5)_S4_$J("",5)
DG53426M ;ALB/AEG - DG*5.3*426 POST INSTALLATION ; 2-21-02
+1 ;;5.3;Registration;**426,1015**;2-21-02;Build 21
+2 ;
CAT1A ; Generate mail message if no records exist to be cleaned up.
+1 IF '$DATA(^TMP($JOB,"CAT 1a"))
Begin DoDot:1
+2 SET ^UTILITY($JOB,1)="No patients on file with a Means Test status of 'REQUIRED' who have"
+3 SET ^UTILITY($JOB,2)="a previous test in either a Cat C or PENDING ADJUDICATION status,"
+4 SET ^UTILITY($JOB,3)="Agreed to pay deductible field is 'YES', and the date of test"
+5 SET ^UTILITY($JOB,4)="is after 10/5/1999. No action required or taken."
+6 NEW DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
+7 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+8 SET XMTEXT="^UTILITY($J,"
SET XMSUB="DG*5.3*426 POST INSTALL REPORT #1"
+9 DO ^XMD
+10 DO MM^DG53426U(XMZ)
+11 KILL ^UTILITY($JOB)
End DoDot:1
+12 QUIT
CAT1AP ; Purged Record Report.
+1 NEW DFN,IEN,NODE0,I
+2 SET (DFN,IEN,NODE0)=""
+3 IF $DATA(^TMP("P-REQ",$JOB))
Begin DoDot:1
+4 SET ^UTILITY($JOB,1)="The following 'REQUIRED' status Means Test records have"
+5 SET ^UTILITY($JOB,2)="been purged from your database. These records were purged"
+6 SET ^UTILITY($JOB,3)="due to the patient having a Means Test meeting the criteria"
+7 SET ^UTILITY($JOB,4)="introduced in patch DG*5.3*326. The criteria are as follows:"
+8 SET ^UTILITY($JOB,5)=" "
+9 SET ^UTILITY($JOB,6)=" 1 - Means Test status is Category C or Pending Adjudication."
+10 SET ^UTILITY($JOB,7)=" 2 - The date of the test is on or after 10/6/1999."
+11 SET ^UTILITY($JOB,8)=" 3 - Agreed to Pay deductible field value is 'YES'."
+12 SET ^UTILITY($JOB,9)=" "
+13 SET ^UTILITY($JOB,10)=$$BLDSTR("PATIENT NAME","SSN"," ","PURGED TEST DATE")
+14 SET ^UTILITY($JOB,11)=$$BLDSTR("------------","---"," ","-------------")
+15 FOR I=12:1
SET DFN=$ORDER(^TMP("P-REQ",$JOB,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+16 NEW DFN1,MTIEN1,TDATE,PID,PNAME,TDATE1
+17 SET DFN1=$PIECE($GET(DFN),"~~",1)
SET MTIEN1=$PIECE($GET(DFN),"~~",2)
+18 SET NODE0=$GET(^TMP("P-REQ",$JOB,DFN))
SET TDATE=$PIECE(NODE0,U,1)
+19 SET Y=TDATE
XECUTE ^DD("DD")
SET TDATE1=Y
+20 SET PNAME=$PIECE($GET(^DPT(DFN1,0)),U,1)
+21 SET PID=$EXTRACT($PIECE($GET(^DPT(DFN1,0)),U,9),1,3)_"-"_$EXTRACT($PIECE($GET(^DPT(DFN1,0)),U,9),4,5)_"-"_$EXTRACT($PIECE($GET(^DPT(DFN1,0)),U,9),6,9)
+22 SET ^UTILITY($JOB,I)=$$BLDSTR(PNAME,PID," ",TDATE1)
End DoDot:2
+23 QUIT
End DoDot:1
+24 IF $DATA(^UTILITY($JOB))
Begin DoDot:1
+25 NEW DIFROM,%,Y,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+26 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+27 SET XMTEXT="^UTILITY($J,"
SET XMSUB="DG*5.3*426 POST INSTALL REPORT #1"
+28 DO ^XMD
+29 DO MM^DG53426U(XMZ)
End DoDot:1
+30 KILL ^UTILITY($JOB),^TMP("P-REQ"),^TMP($JOB,"CAT 1a")
+31 QUIT
+32 ;
CAT1B ; Report to site that no required status tests on file requiring action.
+1 IF '$DATA(^TMP($JOB,"CAT 1b"))
Begin DoDot:1
+2 SET ^UTILITY($JOB,1)="No patients on file with a Means Test status of 'REQUIRED' who do not"
+3 SET ^UTILITY($JOB,2)="meet the search criteria of patch DG*5.3*426."
+4 NEW DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
+5 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+6 SET XMTEXT="^UTILITY($J,"
SET XMSUB="DG*5.3*426 POST INSTALL REPORT #2"
+7 DO ^XMD
+8 DO MM^DG53426U(XMZ)
+9 KILL ^UTILITY($JOB)
End DoDot:1
+10 QUIT
CAT1BR ; Report to the site any record in a 'REQUIRED' status needing
+1 ; action.
+2 IF $DATA(^TMP($JOB,"CAT 1b"))
Begin DoDot:1
+3 NEW DFN,IEN,NODE0
+4 SET (DFN,IEN,NODE0)=""
+5 SET ^UTILITY($JOB,1)="The following Means Tests in your database are in a 'REQUIRED'"
+6 SET ^UTILITY($JOB,2)="status. The historical records do not meet the criteria for"
+7 SET ^UTILITY($JOB,3)="cleanup by patch DG*5.3*426. Please update these records."
+8 SET ^UTILITY($JOB,4)=" "
+9 SET ^UTILITY($JOB,5)=$$BLDSTR("PATIENT NAME","SSN"," ","**TEST DATE**")
+10 SET ^UTILITY($JOB,6)=$$BLDSTR("------------","---"," ","-------------")
+11 NEW PID,PNAME,LST,DGMTDT,DGMTDT1
+12 FOR I=7:1
SET DFN=$ORDER(^TMP($JOB,"CAT 1b",DFN))
IF 'DFN
QUIT
Begin DoDot:2
+13 SET PNAME=$PIECE($GET(^DPT(DFN,0)),U,1)
+14 SET PID=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),1,3)_"-"_$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),4,5)_"-"_$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,9)
+15 SET LST=$$LST^DGMTU(DFN)
SET DGMTDT=$PIECE(LST,U,2)
+16 SET Y=DGMTDT
XECUTE ^DD("DD")
SET DGMTDT1=Y
+17 SET ^UTILITY($JOB,I)=$$BLDSTR(PNAME,PID," ",DGMTDT1)
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 IF $DATA(^UTILITY($JOB))
Begin DoDot:1
+21 NEW DIFROM,%,Y,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+22 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+23 SET XMTEXT="^UTILITY($J,"
SET XMSUB="DG*5.3*426 POST INSTALL REPORT #2"
+24 DO ^XMD
+25 DO MM^DG53426U(XMZ)
End DoDot:1
+26 KILL ^UTILITY($JOB),^TMP($JOB,"CAT 1b")
+27 QUIT
NOCAT2 ; report no cat Cs who declined to give income info but agree to pay
+1 IF '$DATA(^TMP($JOB,"CAT 2"))
Begin DoDot:1
+2 SET ^UTILITY($JOB,1)="No patients on file with a Means Test status of 'REQUIRED' who have"
+3 SET ^UTILITY($JOB,2)="a Category C status test in which the patient declined to give"
+4 SET ^UTILITY($JOB,3)="income information but agreed to pay the deductible."
+5 NEW DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,Y
+6 SET XMDUZ="REGISTRATION PACKAGE"
SET XMY(DUZ)=""
SET XMY(.5)=""
+7 SET XMSUB="DG*5.3*426 POST INSTALL REPORT #3"
SET XMTEXT="^UTILITY($J,"
+8 DO ^XMD
+9 DO MM^DG53426U(XMZ)
+10 KILL ^UTILITY($JOB)
End DoDot:1
+11 QUIT
+12 ;
BLDSTR(P1,P2,P3,P4) ; Build a string from input
+1 NEW S1,S2,S3,S4
+2 SET S1=$EXTRACT(P1,1,15)
IF $LENGTH(S1)'>14
Begin DoDot:1
+3 SET S1=S1_$JUSTIFY("",(15-$LENGTH(S1)))
End DoDot:1
+4 SET S2=P2
+5 SET S3=P3
+6 SET S4=P4
+7 QUIT S1_$JUSTIFY("",5)_S2_$JUSTIFY("",5)_S3_$JUSTIFY("",5)_S4_$JUSTIFY("",5)
