PSOCPBAK ;BIR/EJW-Tally unbilled NON-SERVICE CONNECTED copays ;03/28/03
;;7.0;OUTPATIENT PHARMACY;**137,268,480**;DEC 1997;Build 35
;External reference to ^XUSEC supported by DBIA 10076
;External reference to IBARX supported by DBIA 125
S ZTDTH=""
I $D(ZTQUEUED) S ZTDTH=$H
L +^XTMP("PSOCPBAK"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D Q
. I ZTDTH="" D BMES^XPDUTL("Tally job is already running. Halting...")
L -^XTMP("PSOCPBAK")
I ZTDTH="" D
.D BMES^XPDUTL("Tally unbilled, released NON-SERVICE CONNECTED prescription fills.")
.D BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be ")
.D MES^XPDUTL("queued to run NOW.")
.D GETDATE
.D BMES^XPDUTL("Queuing background job to tally unbilled NON-SERVICE CONNECTED fills...")
S ZTRTN="EN^PSOCPBAK",ZTIO="",ZTDESC="Background job to tally NON-SERVICE CONNECTED unbilled copays" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
Q
EN ;
L +^XTMP("PSOCPBAK"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
N PSODT,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND,PSOVETS
S PSOCNT=0
D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
S PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
I '$G(DT) S DT=$$DT^XLFDT
I '$D(^XTMP("PSOCPBAK")) S X1=DT,X2=+90 D C^%DTC S ^XTMP("PSOCPBAK",0)=$G(X)_"^"_DT
S PSODT=3020203.235959 ; START WITH DATE $7 COPAY WENT INTO EFFECT
F S PSODT=$O(^PSRX("AL",PSODT)) Q:'PSODT S RXP="" F S RXP=$O(^PSRX("AL",PSODT,RXP)) Q:'RXP D
.S PSODFN=$P($G(^PSRX(RXP,0)),"^",2) Q:PSODFN="" I '$D(^DPT(PSODFN,0)) Q
.I $G(^XTMP("PSOCPBAK",$J,PSODFN)) Q ; EXEMPT OR SC QUESTION APPLIES-- NOTHING TO REPROCESS FOR THIS PATIENT
.S BADDT=$G(^XTMP("PSOCPBAK",$J,PSODFN,RXP))
.I 'BADDT D CHKLOG
.I BADDT,BADDT'>$P(PSODT,".") D
..I '$D(^XTMP("PSOCPBAK",$J,PSODFN)) D XTYPE S ^XTMP("PSOCPBAK",$J,PSODFN)=$S(PSOSCMX=1:"",1:1) I PSOSCMX'=1 Q ; QUIT IF SC QUESTION APPLIES -- NOTHING TO REPROCESS
..S YY="" F S YY=$O(^PSRX("AL",PSODT,RXP,YY)) Q:YY="" D
...S PSOREL=$S(YY=0:$P(^PSRX(RXP,2),"^",13),1:$P($G(^PSRX(RXP,1,YY,0)),"^",18)) I 'PSOREL Q ; RELEASED DATE WON'T BE PRESENT IF RETURNED TO STOCK
...I 'YY I $P($G(^PSRX(RXP,"IB")),"^",2)'="" Q ; ALREADY BILLED
...I 'YY I $P($G(^PSRX(RXP,"IB")),"^",4)'="" Q ; ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
...I YY,$P($G(^PSRX(RXP,1,YY,"IB")),"^",1)'="" Q ; REFILL ALREADY BILLED
...I YY,$P($G(^PSRX(RXP,1,YY,"IB")),"^",2)'="" Q ; REFILL ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
...S PSOXIN=$$RXST^IBARXEU(PSODFN,$P(PSOREL,".")) I $P($G(PSOXIN),"^")=1 Q ; INCOME EXEMPT ON RELEASE DATE
...I '$D(^XTMP("PSOCPBAK",$J,PSODFN,RXP)) S ^XTMP("PSOCPBAK",$J,PSODFN,RXP)=BADDT
...S ^XTMP("PSOCPBAK",$J,PSODFN,RXP,YY)=$P(PSOREL,".") ; SAVE TO PROCESS IN "BILL" SECTION
D TALLY^PSOCPBA2
D TOTAL
D MAIL
D MAIL2
L -^XTMP("PSOCPBAK")
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
MAIL ;
D NOW^%DTC S Y=% D DD^%DT S PSOEND=Y
I $G(DUZ) S XMY(DUZ)=""
S XMDUZ="Outpatient Pharmacy",XMSUB="Outpatient Pharmacy Copay Tally"
F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)=""
I $O(XMY(""))="" Q ; no recipients for mail message
S PSOTEXT(1)="The Rx copay tally job for the Outpatient Pharmacy patch (PSO*7*137)"
S PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
I PSOCNT>0 S PSOTEXT(3)="Released non-service connected prescriptions have now been reprocessed."
I PSOCNT>0 S PSOTEXT(4)="There were "_PSOCNT_" fills successfully tallied for "_$G(PSOVETS)_" veterans." D
.S PSOTEXT(5)=" "
.S PSOTEXT(6)="Fills eligible for back-billing by year:"
.S PSOTEXT(7)="2002 30-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",1)
.S PSOTEXT(8)="2002 60-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",2)
.S PSOTEXT(9)="2002 90-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",3)
.S PSOTEXT(10)=""
.S PSOTEXT(11)="2003 30-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",1)
.S PSOTEXT(12)="2003 60-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",2)
.S PSOTEXT(13)="2003 90-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",3)
I PSOCNT=0 S PSOTEXT(3)="No released unbilled copay fills were found."
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
Q
;
MAIL2 ;
N I,COUNTS
D NOW^%DTC S PSOTIME=$$FMDIFF^XLFDT(%,PSOS1,2)
S PSOINST=$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)),"^")
K PSOTEXT
S COUNTS=""
F J="YR2002","YR2003" F I=1:1:3 S COUNTS=COUNTS_"^"_PSOCNT(J,I)
K XMY(DUZ)
S XMY("WHITE.ELAINE@DOMAIN.EXT")=""
S XMY("CARROLL.DAN@DOMAIN.EXT")=""
S XMDUZ="PSO*7*137 TALLY",XMSUB=$G(PSOINST)_" - COUNTS"
S PSOTEXT(1)=PSOSTRT2_"^"_PSOTIME_"^"_$G(PSOVETS)_"^"_PSOCNT_COUNTS
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
Q
;
CHKLOG ;
S BADDT=""
S PSOSQ=0 F S PSOSQ=$O(^PSRX(RXP,"COPAY",PSOSQ)) Q:'PSOSQ S PSOLOG=$G(^PSRX(RXP,"COPAY",PSOSQ,0)) I PSOLOG["Service Connected" S BADDT=$P(PSOLOG,".") Q
Q
;
GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
S ZTDTH=""
S NOW=0
D NOW^%DTC S (Y,TODAY)=% D DD^%DT
D BMES^XPDUTL("At the following prompt, enter a starting date@time")
D MES^XPDUTL("or enter NOW to queue the job immediately.")
D BMES^XPDUTL("If this prompting is during patch installation, you will not see what you type.")
W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue copay tally Job to run Date@Time: "
D ^%DT K %DT I $D(DTOUT)!(Y<0) W "Task will be queued to run NOW" S ZTDTH=$H,NOW=1
I 'NOW,Y>0 D
.S SAVEY=Y
.D DD^%DT
.S X=Y
.S Y=SAVEY
ASK D BMES^XPDUTL("Task will be queued to run "_$S(NOW:"NOW",1:X)_". Is that correct? :")
R XX:300 S:'$T XX="Y" I XX'="Y",XX'="y",XX'="N",XX'="n" W " Enter Y or N" G ASK
I XX'="Y",XX'="y" G GETDATE
I Y>0,ZTDTH="" S ZTDTH=Y
I ZTDTH="" S ZTDTH=$H
Q
;
XTYPE ;
N Y,I,J,X,SAVY,DFN
S DFN=PSODFN D DEM^VADPT I +$G(VADM(6)) S PSOSCMX="" Q ; DECEASED
S (X,PSOSCMX,SAVY)=""
S J=0 F S J=$O(^PS(59,J)) Q:'J I +$G(^(J,"IB")) S X=+^("IB") Q
I 'X Q
S X=X_"^"_PSODFN D XTYPE^IBARX
I $G(Y)'=1 Q
S J="" F S J=$O(Y(J)) Q:'J S I="" F S SAVY=I,I=$O(Y(J,I)) Q:I="" S:I>0 PSOSCMX=I
I PSOSCMX="",SAVY=0 S PSOEXMPT=1 Q ; INCOME EXEMPT OR SERVICE-CONNECTED
I PSOSCMX=2 Q ; NEED TO ASK SC QUESTION
Q
;
TOTAL ;
N COUNT,COUNTED
I '$D(PSOVETS) S PSOVETS=0
N I,J
F I=1:1:3 S (PSOCNT("YR2002",I),PSOCNT("YR2003",I))=0
S PSODFN=0 F S PSODFN=$O(^XTMP("PSOCPBAK",$J,PSODFN)) Q:'PSODFN D
.S COUNTED=0
.F J="YR2002","YR2003" F I=1:1:3 S COUNT=$G(^XTMP("PSOCPBAK",$J,PSODFN,J,I)) I COUNT>0 S:'$G(COUNTED) COUNTED=1,PSOVETS=PSOVETS+1 S PSOCNT(J,I)=PSOCNT(J,I)+COUNT
F I=1:1:3 S PSOCNT=PSOCNT+PSOCNT("YR2002",I)+PSOCNT("YR2003",I)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCPBAK 6738 printed Apr 09, 2024@21:28:08 Page 2
PSOCPBAK ;BIR/EJW-Tally unbilled NON-SERVICE CONNECTED copays ;03/28/03
+1 ;;7.0;OUTPATIENT PHARMACY;**137,268,480**;DEC 1997;Build 35
+2 ;External reference to ^XUSEC supported by DBIA 10076
+3 ;External reference to IBARX supported by DBIA 125
+4 SET ZTDTH=""
+5 IF $DATA(ZTQUEUED)
SET ZTDTH=$HOROLOG
+6 LOCK +^XTMP("PSOCPBAK"):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
Begin DoDot:1
+7 IF ZTDTH=""
DO BMES^XPDUTL("Tally job is already running. Halting...")
End DoDot:1
QUIT
+8 LOCK -^XTMP("PSOCPBAK")
+9 IF ZTDTH=""
Begin DoDot:1
+10 DO BMES^XPDUTL("Tally unbilled, released NON-SERVICE CONNECTED prescription fills.")
+11 DO BMES^XPDUTL("If no start date/time is entered when prompted, the background job will be ")
+12 DO MES^XPDUTL("queued to run NOW.")
+13 DO GETDATE
+14 DO BMES^XPDUTL("Queuing background job to tally unbilled NON-SERVICE CONNECTED fills...")
End DoDot:1
+15 SET ZTRTN="EN^PSOCPBAK"
SET ZTIO=""
SET ZTDESC="Background job to tally NON-SERVICE CONNECTED unbilled copays"
DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+16 if $DATA(ZTSK)&('$DATA(ZTQUEUED))
WRITE !!,"Task Queued !",!
+17 QUIT
EN ;
+1 LOCK +^XTMP("PSOCPBAK"):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 NEW PSODT,RXP,PSOTEXT,YY,PSOCNT,PSOSTART,PSOEND,PSOVETS
+3 SET PSOCNT=0
+4 DO NOW^%DTC
SET (Y,PSOS1)=%
DO DD^%DT
SET PSOSTART=Y
+5 SET PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
+6 IF '$GET(DT)
SET DT=$$DT^XLFDT
+7 IF '$DATA(^XTMP("PSOCPBAK"))
SET X1=DT
SET X2=+90
DO C^%DTC
SET ^XTMP("PSOCPBAK",0)=$GET(X)_"^"_DT
+8 ; START WITH DATE $7 COPAY WENT INTO EFFECT
SET PSODT=3020203.235959
+9 FOR
SET PSODT=$ORDER(^PSRX("AL",PSODT))
if 'PSODT
QUIT
SET RXP=""
FOR
SET RXP=$ORDER(^PSRX("AL",PSODT,RXP))
if 'RXP
QUIT
Begin DoDot:1
+10 SET PSODFN=$PIECE($GET(^PSRX(RXP,0)),"^",2)
if PSODFN=""
QUIT
IF '$DATA(^DPT(PSODFN,0))
QUIT
+11 ; EXEMPT OR SC QUESTION APPLIES-- NOTHING TO REPROCESS FOR THIS PATIENT
IF $GET(^XTMP("PSOCPBAK",$JOB,PSODFN))
QUIT
+12 SET BADDT=$GET(^XTMP("PSOCPBAK",$JOB,PSODFN,RXP))
+13 IF 'BADDT
DO CHKLOG
+14 IF BADDT
IF BADDT'>$PIECE(PSODT,".")
Begin DoDot:2
+15 ; QUIT IF SC QUESTION APPLIES -- NOTHING TO REPROCESS
IF '$DATA(^XTMP("PSOCPBAK",$JOB,PSODFN))
DO XTYPE
SET ^XTMP("PSOCPBAK",$JOB,PSODFN)=$SELECT(PSOSCMX=1:"",1:1)
IF PSOSCMX'=1
QUIT
+16 SET YY=""
FOR
SET YY=$ORDER(^PSRX("AL",PSODT,RXP,YY))
if YY=""
QUIT
Begin DoDot:3
+17 ; RELEASED DATE WON'T BE PRESENT IF RETURNED TO STOCK
SET PSOREL=$SELECT(YY=0:$PIECE(^PSRX(RXP,2),"^",13),1:$PIECE($GET(^PSRX(RXP,1,YY,0)),"^",18))
IF 'PSOREL
QUIT
+18 ; ALREADY BILLED
IF 'YY
IF $PIECE($GET(^PSRX(RXP,"IB")),"^",2)'=""
QUIT
+19 ; ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
IF 'YY
IF $PIECE($GET(^PSRX(RXP,"IB")),"^",4)'=""
QUIT
+20 ; REFILL ALREADY BILLED
IF YY
IF $PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",1)'=""
QUIT
+21 ; REFILL ALREADY BILLED (POTENTIAL BILL - EXCEEDED ANNUAL CAP)
IF YY
IF $PIECE($GET(^PSRX(RXP,1,YY,"IB")),"^",2)'=""
QUIT
+22 ; INCOME EXEMPT ON RELEASE DATE
SET PSOXIN=$$RXST^IBARXEU(PSODFN,$PIECE(PSOREL,"."))
IF $PIECE($GET(PSOXIN),"^")=1
QUIT
+23 IF '$DATA(^XTMP("PSOCPBAK",$JOB,PSODFN,RXP))
SET ^XTMP("PSOCPBAK",$JOB,PSODFN,RXP)=BADDT
+24 ; SAVE TO PROCESS IN "BILL" SECTION
SET ^XTMP("PSOCPBAK",$JOB,PSODFN,RXP,YY)=$PIECE(PSOREL,".")
End DoDot:3
End DoDot:2
End DoDot:1
+25 DO TALLY^PSOCPBA2
+26 DO TOTAL
+27 DO MAIL
+28 DO MAIL2
+29 LOCK -^XTMP("PSOCPBAK")
+30 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+31 QUIT
+32 ;
MAIL ;
+1 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSOEND=Y
+2 IF $GET(DUZ)
SET XMY(DUZ)=""
+3 SET XMDUZ="Outpatient Pharmacy"
SET XMSUB="Outpatient Pharmacy Copay Tally"
+4 FOR PSOCXPDA=0:0
SET PSOCXPDA=$ORDER(^XUSEC("PSO COPAY",PSOCXPDA))
if 'PSOCXPDA
QUIT
SET XMY(PSOCXPDA)=""
+5 ; no recipients for mail message
IF $ORDER(XMY(""))=""
QUIT
+6 SET PSOTEXT(1)="The Rx copay tally job for the Outpatient Pharmacy patch (PSO*7*137)"
+7 SET PSOTEXT(2)="started "_PSOSTART_" and completed "_PSOEND_"."
+8 IF PSOCNT>0
SET PSOTEXT(3)="Released non-service connected prescriptions have now been reprocessed."
+9 IF PSOCNT>0
SET PSOTEXT(4)="There were "_PSOCNT_" fills successfully tallied for "_$GET(PSOVETS)_" veterans."
Begin DoDot:1
+10 SET PSOTEXT(5)=" "
+11 SET PSOTEXT(6)="Fills eligible for back-billing by year:"
+12 SET PSOTEXT(7)="2002 30-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",1)
+13 SET PSOTEXT(8)="2002 60-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",2)
+14 SET PSOTEXT(9)="2002 90-DAY EQUIVALENT FILLS: "_PSOCNT("YR2002",3)
+15 SET PSOTEXT(10)=""
+16 SET PSOTEXT(11)="2003 30-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",1)
+17 SET PSOTEXT(12)="2003 60-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",2)
+18 SET PSOTEXT(13)="2003 90-DAY EQUIVALENT FILLS: "_PSOCNT("YR2003",3)
End DoDot:1
+19 IF PSOCNT=0
SET PSOTEXT(3)="No released unbilled copay fills were found."
+20 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+21 QUIT
+22 ;
MAIL2 ;
+1 NEW I,COUNTS
+2 DO NOW^%DTC
SET PSOTIME=$$FMDIFF^XLFDT(%,PSOS1,2)
+3 SET PSOINST=$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),"^",17),99)),"^")
+4 KILL PSOTEXT
+5 SET COUNTS=""
+6 FOR J="YR2002","YR2003"
FOR I=1:1:3
SET COUNTS=COUNTS_"^"_PSOCNT(J,I)
+7 KILL XMY(DUZ)
+8 SET XMY("WHITE.ELAINE@DOMAIN.EXT")=""
+9 SET XMY("CARROLL.DAN@DOMAIN.EXT")=""
+10 SET XMDUZ="PSO*7*137 TALLY"
SET XMSUB=$GET(PSOINST)_" - COUNTS"
+11 SET PSOTEXT(1)=PSOSTRT2_"^"_PSOTIME_"^"_$GET(PSOVETS)_"^"_PSOCNT_COUNTS
+12 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+13 QUIT
+14 ;
CHKLOG ;
+1 SET BADDT=""
+2 SET PSOSQ=0
FOR
SET PSOSQ=$ORDER(^PSRX(RXP,"COPAY",PSOSQ))
if 'PSOSQ
QUIT
SET PSOLOG=$GET(^PSRX(RXP,"COPAY",PSOSQ,0))
IF PSOLOG["Service Connected"
SET BADDT=$PIECE(PSOLOG,".")
QUIT
+3 QUIT
+4 ;
GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
+1 SET ZTDTH=""
+2 SET NOW=0
+3 DO NOW^%DTC
SET (Y,TODAY)=%
DO DD^%DT
+4 DO BMES^XPDUTL("At the following prompt, enter a starting date@time")
+5 DO MES^XPDUTL("or enter NOW to queue the job immediately.")
+6 DO BMES^XPDUTL("If this prompting is during patch installation, you will not see what you type.")
+7 WRITE !
KILL %DT
DO NOW^%DTC
SET %DT="RAEX"
SET %DT(0)=%
SET %DT("A")="Queue copay tally Job to run Date@Time: "
+8 DO ^%DT
KILL %DT
IF $DATA(DTOUT)!(Y<0)
WRITE "Task will be queued to run NOW"
SET ZTDTH=$HOROLOG
SET NOW=1
+9 IF 'NOW
IF Y>0
Begin DoDot:1
+10 SET SAVEY=Y
+11 DO DD^%DT
+12 SET X=Y
+13 SET Y=SAVEY
End DoDot:1
ASK DO BMES^XPDUTL("Task will be queued to run "_$SELECT(NOW:"NOW",1:X)_". Is that correct? :")
+1 READ XX:300
if '$TEST
SET XX="Y"
IF XX'="Y"
IF XX'="y"
IF XX'="N"
IF XX'="n"
WRITE " Enter Y or N"
GOTO ASK
+2 IF XX'="Y"
IF XX'="y"
GOTO GETDATE
+3 IF Y>0
IF ZTDTH=""
SET ZTDTH=Y
+4 IF ZTDTH=""
SET ZTDTH=$HOROLOG
+5 QUIT
+6 ;
XTYPE ;
+1 NEW Y,I,J,X,SAVY,DFN
+2 ; DECEASED
SET DFN=PSODFN
DO DEM^VADPT
IF +$GET(VADM(6))
SET PSOSCMX=""
QUIT
+3 SET (X,PSOSCMX,SAVY)=""
+4 SET J=0
FOR
SET J=$ORDER(^PS(59,J))
if 'J
QUIT
IF +$GET(^(J,"IB"))
SET X=+^("IB")
QUIT
+5 IF 'X
QUIT
+6 SET X=X_"^"_PSODFN
DO XTYPE^IBARX
+7 IF $GET(Y)'=1
QUIT
+8 SET J=""
FOR
SET J=$ORDER(Y(J))
if 'J
QUIT
SET I=""
FOR
SET SAVY=I
SET I=$ORDER(Y(J,I))
if I=""
QUIT
if I>0
SET PSOSCMX=I
+9 ; INCOME EXEMPT OR SERVICE-CONNECTED
IF PSOSCMX=""
IF SAVY=0
SET PSOEXMPT=1
QUIT
+10 ; NEED TO ASK SC QUESTION
IF PSOSCMX=2
QUIT
+11 QUIT
+12 ;
TOTAL ;
+1 NEW COUNT,COUNTED
+2 IF '$DATA(PSOVETS)
SET PSOVETS=0
+3 NEW I,J
+4 FOR I=1:1:3
SET (PSOCNT("YR2002",I),PSOCNT("YR2003",I))=0
+5 SET PSODFN=0
FOR
SET PSODFN=$ORDER(^XTMP("PSOCPBAK",$JOB,PSODFN))
if 'PSODFN
QUIT
Begin DoDot:1
+6 SET COUNTED=0
+7 FOR J="YR2002","YR2003"
FOR I=1:1:3
SET COUNT=$GET(^XTMP("PSOCPBAK",$JOB,PSODFN,J,I))
IF COUNT>0
if '$GET(COUNTED)
SET COUNTED=1
SET PSOVETS=PSOVETS+1
SET PSOCNT(J,I)=PSOCNT(J,I)+COUNT
End DoDot:1
+8 FOR I=1:1:3
SET PSOCNT=PSOCNT+PSOCNT("YR2002",I)+PSOCNT("YR2003",I)
+9 QUIT
+10 ;
