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
