- 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)
