- DG53426N ;ALB/AEG - DG*5.3*426 POST INSTALL CONT. ;2-21-02
- ;;5.3;Registration;**426,1015**;2-21-02;Build 21
- ;
- CAT2P ; Process those tests where the patient was in a 'REQUIRED' status but
- ; had a test on file previously that was Category C, patient declined
- ; to provide income information but did agree to pay the deductible.
- I $D(^TMP("P-REQ",$J)) D
- .N DFN,IEN,NODE0,I
- .S (DFN,IEN,I,NODE0)=""
- .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 previously on file"
- .S ^UTILITY($J,4)="with a status of Category C. The Category C test on these"
- .S ^UTILITY($J,5)="persons is a result of the patient declining to provide"
- .S ^UTILITY($J,6)="income information but agreeing to pay the deductible charges."
- .S ^UTILITY($J,7)=" "
- .S ^UTILITY($J,8)=$$BLDSTR^DG53426M("PATIENT NAME","SSN"," ","PURGED TEST DATE")
- .S ^UTILITY($J,9)=$$BLDSTR^DG53426M("------------","---"," ","-------------")
- .F I=10: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^DG53426M(PNAME,PID," ",TDATE1)
- ..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 #3"
- .D ^XMD
- .D MM^DG53426U(XMZ)
- K ^UTILITY($J),^TMP("P-REQ"),^TMP($J,"CAT 2")
- Q
- NOCAT3 ; report no Cat Cs who declined to provide income info and who also
- ; refused AGREE TO PAY.
- I '$D(^TMP($J,"CAT 3")) 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 test in which the patient declined to give income"
- .S ^UTILITY($J,3)="information and did NOT agree to pay deductible."
- .S ^UTILITY($J,4)=" "
- .N DIFROM,%,XMDUZ,XMTEXT,XMY,Y
- .S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
- .S XMSUB="DG*5.3*426 POST INSTALL REPORT #4",XMTEXT="^UTILITY($J,"
- .D ^XMD
- .D MM^DG53426U(XMZ)
- .K ^UTILITY($J)
- Q
- CAT3 ; report on those patients who are currently in a REQUIRED status but
- ; have a CAT C test on file in which they declined to give income info
- ; & did NOT agree to pay deductible.
- I $D(^TMP($J,"CAT 3")) D
- .N DFN,IEN,NODE0
- .S (DFN,IEN,NODE0)=""
- .S ^UTILITY($J,1)="The following patients have a current Means Test status of 'REQUIRED'."
- .S ^UTILITY($J,2)="The veteran declined to provide income information AND did"
- .S ^UTILITY($J,3)="NOT agree to pay the deductible on a previous test. Please update"
- .S ^UTILITY($J,4)="the 'REQUIRED' status test(s)."
- .S ^UTILITY($J,5)=" "
- .S ^UTILITY($J,6)=$$BLDSTR^DG53426M("PATIENT NAME","SSN"," ","**TEST DATE**")
- .S ^UTILITY($J,7)=$$BLDSTR^DG53426M("------------","---"," ","-------------")
- .N PID,PNAME,LST,DGMTDT,DGMTDT1
- .F I=8:1 S DFN=$O(^TMP($J,"CAT 3",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^DG53426M(PNAME,PID," ",DGMTDT1)
- ..Q
- .Q
- I $D(^UTILITY($J)) D
- .N DIFROM,%,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 #4"
- .D ^XMD
- .D MM^DG53426U(XMZ)
- .K ^UTILITY($J),^TMP($J,"CAT 3")
- Q
- CAT4 ;
- I $D(^TMP($J,"CAT 4")) D
- .N DFN,IEN,NODE0
- .S (DFN,IEN,NODE0)=""
- .S ^UTILITY($J,1)="The following patients have a current Means Test status of 'REQUIRED'."
- .S ^UTILITY($J,2)="The below patient(s) previously had a Means Test in which they did"
- .S ^UTILITY($J,3)="provide income information but did NOT agree to pay the deductible."
- .S ^UTILITY($J,4)="Please update these records."
- .S ^UTILITY($J,5)=" "
- .S ^UTILITY($J,6)=$$BLDSTR^DG53426M("PATIENT NAME","SSN"," ","**TEST DATE**")
- .S ^UTILITY($J,7)=$$BLDSTR^DG53426M("------------","---"," ","-------------")
- .N PID,PNAME,LST,DGMTDT,DGMTDT1
- .F I=8:1 S DFN=$O(^TMP($J,"CAT 4",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^DG53426M(PNAME,PID," ",DGMTDT1)
- ..Q
- .Q
- I $D(^UTILITY($J)) D
- .N DIFROM,%,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 #5"
- .D ^XMD
- .D MM^DG53426U(XMZ)
- .K ^UTILITY($J),^TMP($J,"CAT 4")
- Q
- NOCAT4 ;
- I '$D(^TMP($J,"CAT 4")) D
- .S ^UTILITY($J,1)="No patients currently in a Means Test 'REQUIRED' status who"
- .S ^UTILITY($J,2)="previously had a Category C test in which income information"
- .S ^UTILITY($J,3)="was provided but patient did NOT agree to pay deductible."
- .N DIFROM,%,XMDUZ,XMTEXT,XMY,Y
- .S XMDUZ="REGISTRATION PACKAGE",XMY(DUZ)="",XMY(.5)=""
- .S XMSUB="DG*5.3*426 POST INSTALL REPORT #5",XMTEXT="^UTILITY($J,"
- .D ^XMD
- .D MM^DG53426U(XMZ)
- .K ^UTILITY($J)
- Q
- DG53426N ;ALB/AEG - DG*5.3*426 POST INSTALL CONT. ;2-21-02
- +1 ;;5.3;Registration;**426,1015**;2-21-02;Build 21
- +2 ;
- CAT2P ; Process those tests where the patient was in a 'REQUIRED' status but
- +1 ; had a test on file previously that was Category C, patient declined
- +2 ; to provide income information but did agree to pay the deductible.
- +3 IF $DATA(^TMP("P-REQ",$JOB))
- Begin DoDot:1
- +4 NEW DFN,IEN,NODE0,I
- +5 SET (DFN,IEN,I,NODE0)=""
- +6 SET ^UTILITY($JOB,1)="The following 'REQUIRED' status Means Test records have"
- +7 SET ^UTILITY($JOB,2)="been purged from your database. These records were purged"
- +8 SET ^UTILITY($JOB,3)="due to the patient having a Means Test previously on file"
- +9 SET ^UTILITY($JOB,4)="with a status of Category C. The Category C test on these"
- +10 SET ^UTILITY($JOB,5)="persons is a result of the patient declining to provide"
- +11 SET ^UTILITY($JOB,6)="income information but agreeing to pay the deductible charges."
- +12 SET ^UTILITY($JOB,7)=" "
- +13 SET ^UTILITY($JOB,8)=$$BLDSTR^DG53426M("PATIENT NAME","SSN"," ","PURGED TEST DATE")
- +14 SET ^UTILITY($JOB,9)=$$BLDSTR^DG53426M("------------","---"," ","-------------")
- +15 FOR I=10: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^DG53426M(PNAME,PID," ",TDATE1)
- +23 QUIT
- End DoDot:2
- +24 QUIT
- End DoDot:1
- +25 IF $DATA(^UTILITY($JOB))
- Begin DoDot:1
- +26 NEW DIFROM,%,Y,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +27 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +28 SET XMTEXT="^UTILITY($J,"
- SET XMSUB="DG*5.3*426 POST INSTALL REPORT #3"
- +29 DO ^XMD
- +30 DO MM^DG53426U(XMZ)
- End DoDot:1
- +31 KILL ^UTILITY($JOB),^TMP("P-REQ"),^TMP($JOB,"CAT 2")
- +32 QUIT
- NOCAT3 ; report no Cat Cs who declined to provide income info and who also
- +1 ; refused AGREE TO PAY.
- +2 IF '$DATA(^TMP($JOB,"CAT 3"))
- Begin DoDot:1
- +3 SET ^UTILITY($JOB,1)="No patients on file with a Means Test status of 'REQUIRED' who have"
- +4 SET ^UTILITY($JOB,2)="a Category C test in which the patient declined to give income"
- +5 SET ^UTILITY($JOB,3)="information and did NOT agree to pay deductible."
- +6 SET ^UTILITY($JOB,4)=" "
- +7 NEW DIFROM,%,XMDUZ,XMTEXT,XMY,Y
- +8 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +9 SET XMSUB="DG*5.3*426 POST INSTALL REPORT #4"
- SET XMTEXT="^UTILITY($J,"
- +10 DO ^XMD
- +11 DO MM^DG53426U(XMZ)
- +12 KILL ^UTILITY($JOB)
- End DoDot:1
- +13 QUIT
- CAT3 ; report on those patients who are currently in a REQUIRED status but
- +1 ; have a CAT C test on file in which they declined to give income info
- +2 ; & did NOT agree to pay deductible.
- +3 IF $DATA(^TMP($JOB,"CAT 3"))
- Begin DoDot:1
- +4 NEW DFN,IEN,NODE0
- +5 SET (DFN,IEN,NODE0)=""
- +6 SET ^UTILITY($JOB,1)="The following patients have a current Means Test status of 'REQUIRED'."
- +7 SET ^UTILITY($JOB,2)="The veteran declined to provide income information AND did"
- +8 SET ^UTILITY($JOB,3)="NOT agree to pay the deductible on a previous test. Please update"
- +9 SET ^UTILITY($JOB,4)="the 'REQUIRED' status test(s)."
- +10 SET ^UTILITY($JOB,5)=" "
- +11 SET ^UTILITY($JOB,6)=$$BLDSTR^DG53426M("PATIENT NAME","SSN"," ","**TEST DATE**")
- +12 SET ^UTILITY($JOB,7)=$$BLDSTR^DG53426M("------------","---"," ","-------------")
- +13 NEW PID,PNAME,LST,DGMTDT,DGMTDT1
- +14 FOR I=8:1
- SET DFN=$ORDER(^TMP($JOB,"CAT 3",DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +15 SET PNAME=$PIECE($GET(^DPT(DFN,0)),U,1)
- +16 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)
- +17 SET LST=$$LST^DGMTU(DFN)
- SET DGMTDT=$PIECE(LST,U,2)
- +18 SET Y=DGMTDT
- XECUTE ^DD("DD")
- SET DGMTDT1=Y
- +19 SET ^UTILITY($JOB,I)=$$BLDSTR^DG53426M(PNAME,PID," ",DGMTDT1)
- +20 QUIT
- End DoDot:2
- +21 QUIT
- End DoDot:1
- +22 IF $DATA(^UTILITY($JOB))
- Begin DoDot:1
- +23 NEW DIFROM,%,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
- +24 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +25 SET XMTEXT="^UTILITY($J,"
- SET XMSUB="DG*5.3*426 POST INSTALL REPORT #4"
- +26 DO ^XMD
- +27 DO MM^DG53426U(XMZ)
- +28 KILL ^UTILITY($JOB),^TMP($JOB,"CAT 3")
- End DoDot:1
- +29 QUIT
- CAT4 ;
- +1 IF $DATA(^TMP($JOB,"CAT 4"))
- Begin DoDot:1
- +2 NEW DFN,IEN,NODE0
- +3 SET (DFN,IEN,NODE0)=""
- +4 SET ^UTILITY($JOB,1)="The following patients have a current Means Test status of 'REQUIRED'."
- +5 SET ^UTILITY($JOB,2)="The below patient(s) previously had a Means Test in which they did"
- +6 SET ^UTILITY($JOB,3)="provide income information but did NOT agree to pay the deductible."
- +7 SET ^UTILITY($JOB,4)="Please update these records."
- +8 SET ^UTILITY($JOB,5)=" "
- +9 SET ^UTILITY($JOB,6)=$$BLDSTR^DG53426M("PATIENT NAME","SSN"," ","**TEST DATE**")
- +10 SET ^UTILITY($JOB,7)=$$BLDSTR^DG53426M("------------","---"," ","-------------")
- +11 NEW PID,PNAME,LST,DGMTDT,DGMTDT1
- +12 FOR I=8:1
- SET DFN=$ORDER(^TMP($JOB,"CAT 4",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^DG53426M(PNAME,PID," ",DGMTDT1)
- +18 QUIT
- End DoDot:2
- +19 QUIT
- End DoDot:1
- +20 IF $DATA(^UTILITY($JOB))
- Begin DoDot:1
- +21 NEW DIFROM,%,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 #5"
- +24 DO ^XMD
- +25 DO MM^DG53426U(XMZ)
- +26 KILL ^UTILITY($JOB),^TMP($JOB,"CAT 4")
- End DoDot:1
- +27 QUIT
- NOCAT4 ;
- +1 IF '$DATA(^TMP($JOB,"CAT 4"))
- Begin DoDot:1
- +2 SET ^UTILITY($JOB,1)="No patients currently in a Means Test 'REQUIRED' status who"
- +3 SET ^UTILITY($JOB,2)="previously had a Category C test in which income information"
- +4 SET ^UTILITY($JOB,3)="was provided but patient did NOT agree to pay deductible."
- +5 NEW DIFROM,%,XMDUZ,XMTEXT,XMY,Y
- +6 SET XMDUZ="REGISTRATION PACKAGE"
- SET XMY(DUZ)=""
- SET XMY(.5)=""
- +7 SET XMSUB="DG*5.3*426 POST INSTALL REPORT #5"
- SET XMTEXT="^UTILITY($J,"
- +8 DO ^XMD
- +9 DO MM^DG53426U(XMZ)
- +10 KILL ^UTILITY($JOB)
- End DoDot:1
- +11 QUIT
