PSOPTPST ;BIR/DSD - Post Patient Selection Action ;27-Aug-2013 14:35;DU
;;7.0;OUTPATIENT PHARMACY;**7,71,88,146,157,1005,143,225,1015,1017**;DEC 1997;Build 40
;External reference to SDCO22 supported by DBIA 1579
;External reference to IBE(350.1,"ANEW" supported by DBIA 592
;External reference to PS(55 supported by DBIA 2228
;External reference to IBARX supported by DBIA 125
;External reference to $$GETSHAD^DGUTL3 supported by DBIA 4462
; Modified - IHS/CIA/PLS - 01/06/04 - Added output logic for CAP and Insurance Info
; 04/05/04 - Prevent PSODFN Undefined error
; IHS/MSC/PLS - 08/30/06 - INSURER API - Added Plan Name to output
; 02/13/07 - QST+5 - Commented out call to DGCV
; 08/27/13 - INP
START S PSOQFLG=0
G:'$G(PSODFN) END ; IHS/CIA/PLS - 04/05/04 - Prevent undefined error at GET^PSOPTPST
D GET ; Gets data from Patient file
D DEAD G:PSOQFLG END ; Checks to see if patient still alive
G:$G(PSOFROM("PTLKUP"))']"" END ; skips questions if not called by RX data entry
D INP G:PSOQFLG END ;Checks to see if inpatient and whether to continue
D INSUR ; IHS/CIA/PLS - 01/06/04 - Display insurer
D CAP ; IHS/CIA/PLS - 01/06/04 - Display Safety cap status
D CNH G:PSOQFLG END ; Checks to see if nursing home patient
D ELIG ; Checks eligibility
D:$G(DUZ("AG"))="V" COPAY ; Deals with copay
D ADDRESS ; Display address information
D:$G(^PS(55,PSODFN,1))]"" REMARKS ; Displays narrative about patient
END D EOJ
Q
;----------------------------------------------------------
GET K DIC,DR,DIQ S DIC=2,DA=PSODFN,DR=".1;.172;.351;.361;148",DIQ="PSOPTPST"
D EN^DIQ1 K DIC,DA,DR,DIQ
Q
;
DEAD ;
I $G(PSOPTPST(2,PSODFN,.351))]"" S (PSODEATH,PSOQFLG)=1 S SSN=$P(^DPT(PSODFN,0),"^",9) W !?10,$C(7),PSORX("NAME")_" ("_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_") DIED "_PSOPTPST(2,PSODFN,.351),! S:$G(POERR) POERR("DEAD")=1 D
.;I '$O(^PS(55,PSODFN,"P","A",DT)) Q
.S ACOM="Date of Death "_PSOPTPST(2,PSODFN,.351)_".",ZTRTN="CAN^PSOCAN3",ZTDESC="Outpatient Pharmacy Autocancel Due to Death of Patient",ZTSAVE("ACOM")="",ZTSAVE("PSODFN")="",ZTSAVE("PSODEATH")=""
.S ZTIO="",PSOCLC=DUZ,ZTSAVE("PSOCLC")="",ZTDTH=$H D ^%ZTLOAD K ACOM,ZTSK,PSODEATH
Q
;
INP ;I '$G(PSOXFLG),'$G(PSOFIN),$G(PSOPTPST(2,PSODFN,.1))]"" S PSOXFLG=1,SSN=$P(^DPT(PSODFN,0),"^",9) W !!?10,$C(7),PSORX("NAME")_" ("_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_")" K SSN
I '$G(PSOXFLG),'$G(PSOFIN),$G(PSOPTPST(2,PSODFN,.1))]"" S PSOXFLG=1,SSN=$P(^DPT(PSODFN,0),"^",9) W !!?10,$C(7),PSORX("NAME")_" (XXX-XX-"_$E(SSN,6,9)_")" K SSN
I $G(PSOPTPST(2,PSODFN,.1))]"" W !?10,$C(7),"Patient is an Inpatient on Ward "_PSOPTPST(2,PSODFN,.1)_" !!" D DIR
Q
TPB ;
N PSOTPSSN
I '$G(PSODFN) Q
I $D(^PS(52.91,PSODFN,0)) I '$P(^PS(52.91,PSODFN,0),"^",3)!($P(^(0),"^",3)>DT) D
.S PSOTPSSN=$P($G(^DPT(PSODFN,0)),"^",9)
.I $G(PSOFIN)!($G(MEDP)) D
..I $G(MEDP) W !!?10,$C(7),$P($G(^DPT(PSODFN,0)),"^")_" ("_$E(PSOTPSSN,1,3)_"-"_$E(PSOTPSSN,4,5)_"-"_$E(PSOTPSSN,6,9)_")" Q
..I $G(PSOFIN) I $G(PSOPTPST(2,PSODFN,148))="YES"!($G(PSOPTPST(2,PSODFN,.1))]"") W !!?10,$C(7),$P($G(^DPT(PSODFN,0)),"^")_" ("_$E(PSOTPSSN,1,3)_"-"_$E(PSOTPSSN,4,5)_"-"_$E(PSOTPSSN,6,9)_")"
.I '$G(PSOFIN),'$G(MEDP) W !
.W !?10,"Patient is eligible for the Transitional Pharmacy Benefit!!" D DIR
Q
;
CNH I $G(MEDP),$G(PSOPTPST(2,PSODFN,148))="YES",$G(PSOPTPST(2,PSODFN,.1))']"" D
.S SSN=$P(^DPT(PSODFN,0),"^",9) W !!?10,$C(7),PSORX("NAME")_" ("_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_")" K SSN
K PSORX("CNH") I $G(PSOPTPST(2,PSODFN,148))="YES" W !?10,$C(7),"Patient is in a Contract Nursing Home !!" D DIR S:'$G(PSOQFLG) PSORX("CNH")=1
Q
;
ELIG I $G(PSOPTPST(2,PSODFN,.361))]"",$G(PSOPTPST(2,PSODFN,.172))'="I" W !,"MAS Eligibility: "_PSOPTPST(2,PSODFN,.361)
S DFN=PSODFN D RE^PSODEM
Q
;
COPAY K PSOBILL,PSOCPAY S DFN=PSODFN,(X,PSOPTIB)=$P($G(^PS(59,+PSOSITE,"IB")),"^")_"^"_PSODFN D XTYPE^IBARX
I '$D(^IBE(350.1,"ANEW",+PSOPTIB,1,1)) S PSOQFLG=1 D K PSOPTIB Q
.W $C(7),!!,"There is a problem with the IB SERVICE/SECTION entry in your Pharmacy Site File."
.W !,"You will not be able to enter any new prescriptions until this is corrected!",!
S (ACTYP,BL)="",(PSOBILL,PSOCPAY)=0 I +Y=-1 W !,"ERROR IN COPAY ELIGIBILITY ENCOUNTERED." G COPAYX
COPAY1 S ACTYP=$O(Y(ACTYP)) G:'ACTYP COPAYX F III=0:0 S BL=$O(Y(ACTYP,BL)) Q:BL="" I BL>0 S PSOBILL=BL,PSOCPAY=BL_"^"_Y(ACTYP,BL)
G COPAY1
COPAYX K X,Y,ACTYP,BL,III,PSOPTIB
;I $G(PSOBILL)
D QST
Q
;
ADDRESS N DFN S (DA,DFN)=PSODFN D ADD^VADPT K DFN,PSOI,DA,DR
Q
;
F PSOI=1:1 Q:$P(PSOX," ",PSOI,900)="" W:$X+$L($P(PSOX," ",PSOI))+$L(" ")>IOM !?5 W $P(PSOX," ",PSOI)_" "
K PSOX,PSOI
Q
;
INSUR ; IHS/CIA/PLS - 01/06/04 - Display Insurance Information
N IORVON,IORVOFF,IOBON,IOBOFF,MCR
S X="IORVON;IORVOFF;IOBON;IOBOFF" D ENDR^%ZISS
I $$MCD^APSQPINS($S($D(PSODFN):PSODFN,$D(DFN):DFN,1:""),DT) D
.W !,?30,IORVON,IOBON,"MEDICAID PATIENT"_"*"_$$GP^APSQPINS($$MCD^APSQPINS($S($D(PSODFN):PSODFN,$D(DFN):DFN,1:""),DT))_"*"_IORVOFF,IOBOFF
.F I=1:1:2 W *7," "
S MCR=$$MCR^APSQPINS($S($D(PSODFN):PSODFN,$D(DFN):DFN,1:""),DT)
I MCR D
.W !,?30,IORVON,IOBON,"MEDICARE PATIENT - "_$$GET1^DIQ(9999999.18,+$P(MCR,U,2),.01)_" - "_$S(MCR:"Grace Period: "_$$GP^APSQPINS(+MCR),1:"No Data"),IORVOFF,IOBOFF ;IHS/MSC/PLS - 08/30/06 Added Plan Name
.F I=1:1:2 W *7," "
I $$PIN^APSQPINS($S($D(PSODFN):PSODFN,$D(DFN):DFN,1:""),DT,"E")]"" D
.W !,?10,IORVON,IOBON,$$PIN^APSQPINS($S($D(PSODFN):PSODFN,$D(DFN):DFN,1:""),DT,"E"),!,IORVOFF,IOBOFF
.F I=1:1:2 W *7," "
Q
;
CAP ; IHS/CIA/PLS - 01/06/04 - Display Safety Status for Bottles
N X,Y,IORVON,IORVOFF
S Y=$$GET1^DIQ(55,PSODFN_",",.02,"I")
S:Y X="IORVON;IORVOFF" D ENDR^%ZISS
W ?($X+2),"CAP STATUS: ",$S(Y=0:"SAFETY CAPS OK",Y=1:IORVON_"NON SAFETY CAPS REQUESTED"_IORVOFF,1:"UNKNOWN STATUS")
Q
DIR K DIR W !
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do You Want To Continue" D ^DIR K DIR
S:'Y PSOQFLG=1 K X,Y,DIRUT,DTOUT,DUOUT
Q
;
EOJ K:PSOQFLG PSORX("CNH") K PSOPTPST,VAPA
Q
QST ;Ask new questions for Copay
I '$$DT^PSOMLLDT Q
K PSOIBQS
I $G(PSOBILL) S PSOIBQS(PSODFN,"SC")=""
S PSOIBQS(PSODFN,"SC>50")=""
;IHS/MSC/PLS - 2/13/07 - Next line commented out because of NOROUTINE error
;I +$P($$CVEDT^DGCV(PSODFN),"^",3) S PSOIBQS(PSODFN,"CV")=""
I $$AO^SDCO22(PSODFN) S PSOIBQS(PSODFN,"VEH")=""
I $$IR^SDCO22(PSODFN) S PSOIBQS(PSODFN,"RAD")=""
I $$EC^SDCO22(PSODFN) S PSOIBQS(PSODFN,"PGW")=""
I $L($T(GETSHAD^DGUTL3)) S:$$GETSHAD^DGUTL3(PSODFN)=1 PSOIBQS(PSODFN,"SHAD")=""
I $P($$GETSTAT^DGMSTAPI(PSODFN),"^",2)="Y" S PSOIBQS(PSODFN,"MST")=""
I $T(GETCUR^DGNTAPI)]"" N PSONCP,PSONCPX S PSONCPX=$$GETCUR^DGNTAPI(PSODFN,"PSONCP") I $P($G(PSONCP("IND")),"^")="Y" S PSOIBQS(PSODFN,"HNC")=""
Q
PSOPTPST ;BIR/DSD - Post Patient Selection Action ;27-Aug-2013 14:35;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**7,71,88,146,157,1005,143,225,1015,1017**;DEC 1997;Build 40
+2 ;External reference to SDCO22 supported by DBIA 1579
+3 ;External reference to IBE(350.1,"ANEW" supported by DBIA 592
+4 ;External reference to PS(55 supported by DBIA 2228
+5 ;External reference to IBARX supported by DBIA 125
+6 ;External reference to $$GETSHAD^DGUTL3 supported by DBIA 4462
+7 ; Modified - IHS/CIA/PLS - 01/06/04 - Added output logic for CAP and Insurance Info
+8 ; 04/05/04 - Prevent PSODFN Undefined error
+9 ; IHS/MSC/PLS - 08/30/06 - INSURER API - Added Plan Name to output
+10 ; 02/13/07 - QST+5 - Commented out call to DGCV
+11 ; 08/27/13 - INP
START SET PSOQFLG=0
+1 ; IHS/CIA/PLS - 04/05/04 - Prevent undefined error at GET^PSOPTPST
IF '$GET(PSODFN)
GOTO END
+2 ; Gets data from Patient file
DO GET
+3 ; Checks to see if patient still alive
DO DEAD
IF PSOQFLG
GOTO END
+4 ; skips questions if not called by RX data entry
IF $GET(PSOFROM("PTLKUP"))']""
GOTO END
+5 ;Checks to see if inpatient and whether to continue
DO INP
IF PSOQFLG
GOTO END
+6 ; IHS/CIA/PLS - 01/06/04 - Display insurer
DO INSUR
+7 ; IHS/CIA/PLS - 01/06/04 - Display Safety cap status
DO CAP
+8 ; Checks to see if nursing home patient
DO CNH
IF PSOQFLG
GOTO END
+9 ; Checks eligibility
DO ELIG
+10 ; Deals with copay
IF $GET(DUZ("AG"))="V"
DO COPAY
+11 ; Display address information
DO ADDRESS
+12 ; Displays narrative about patient
IF $GET(^PS(55,PSODFN,1))]""
DO REMARKS
END DO EOJ
+1 QUIT
+2 ;----------------------------------------------------------
GET KILL DIC,DR,DIQ
SET DIC=2
SET DA=PSODFN
SET DR=".1;.172;.351;.361;148"
SET DIQ="PSOPTPST"
+1 DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+2 QUIT
+3 ;
DEAD ;
+1 IF $GET(PSOPTPST(2,PSODFN,.351))]""
SET (PSODEATH,PSOQFLG)=1
SET SSN=$PIECE(^DPT(PSODFN,0),"^",9)
WRITE !?10,$CHAR(7),PSORX("NAME")_" ("_$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)_") DIED "_PSOPTPST(2,PSODFN,.351),!
IF $GET(POERR)
SET POERR("DEAD")=1
Begin DoDot:1
+2 ;I '$O(^PS(55,PSODFN,"P","A",DT)) Q
+3 SET ACOM="Date of Death "_PSOPTPST(2,PSODFN,.351)_"."
SET ZTRTN="CAN^PSOCAN3"
SET ZTDESC="Outpatient Pharmacy Autocancel Due to Death of Patient"
SET ZTSAVE("ACOM")=""
SET ZTSAVE("PSODFN")=""
SET ZTSAVE("PSODEATH")=""
+4 SET ZTIO=""
SET PSOCLC=DUZ
SET ZTSAVE("PSOCLC")=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
KILL ACOM,ZTSK,PSODEATH
End DoDot:1
+5 QUIT
+6 ;
INP ;I '$G(PSOXFLG),'$G(PSOFIN),$G(PSOPTPST(2,PSODFN,.1))]"" S PSOXFLG=1,SSN=$P(^DPT(PSODFN,0),"^",9) W !!?10,$C(7),PSORX("NAME")_" ("_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_")" K SSN
+1 IF '$GET(PSOXFLG)
IF '$GET(PSOFIN)
IF $GET(PSOPTPST(2,PSODFN,.1))]""
SET PSOXFLG=1
SET SSN=$PIECE(^DPT(PSODFN,0),"^",9)
WRITE !!?10,$CHAR(7),PSORX("NAME")_" (XXX-XX-"_$EXTRACT(SSN,6,9)_")"
KILL SSN
+2 IF $GET(PSOPTPST(2,PSODFN,.1))]""
WRITE !?10,$CHAR(7),"Patient is an Inpatient on Ward "_PSOPTPST(2,PSODFN,.1)_" !!"
DO DIR
+3 QUIT
TPB ;
+1 NEW PSOTPSSN
+2 IF '$GET(PSODFN)
QUIT
+3 IF $DATA(^PS(52.91,PSODFN,0))
IF '$PIECE(^PS(52.91,PSODFN,0),"^",3)!($PIECE(^(0),"^",3)>DT)
Begin DoDot:1
+4 SET PSOTPSSN=$PIECE($GET(^DPT(PSODFN,0)),"^",9)
+5 IF $GET">GET(PSOFIN)!($GET">GET(MEDP))
Begin DoDot:2
+6 IF $GET(MEDP)
WRITE !!?10,$CHAR(7),$PIECE($GET(^DPT(PSODFN,0)),"^")_" ("_$EXTRACT(PSOTPSSN,1,3)_"-"_$EXTRACT(PSOTPSSN,4,5)_"-"_$EXTRACT(PSOTPSSN,6,9)_")"
QUIT
+7 IF $GET(PSOFIN)
IF $GET">GET(PSOPTPST(2,PSODFN,148))="YES"!($GET">GET(PSOPTPST(2,PSODFN,.1))]"")
WRITE !!?10,$CHAR(7),$PIECE($GET(^DPT(PSODFN,0)),"^")_" ("_$EXTRACT(PSOTPSSN,1,3)_"-"_$EXTRACT(PSOTPSSN,4,5)_"-"_$EXTRACT(PSOTPSSN,6,9)_")"
End DoDot:2
+8 IF '$GET(PSOFIN)
IF '$GET(MEDP)
WRITE !
+9 WRITE !?10,"Patient is eligible for the Transitional Pharmacy Benefit!!"
DO DIR
End DoDot:1
+10 QUIT
+11 ;
CNH IF $GET(MEDP)
IF $GET(PSOPTPST(2,PSODFN,148))="YES"
IF $GET(PSOPTPST(2,PSODFN,.1))']""
Begin DoDot:1
+1 SET SSN=$PIECE(^DPT(PSODFN,0),"^",9)
WRITE !!?10,$CHAR(7),PSORX("NAME")_" ("_$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)_")"
KILL SSN
End DoDot:1
+2 KILL PSORX("CNH")
IF $GET(PSOPTPST(2,PSODFN,148))="YES"
WRITE !?10,$CHAR(7),"Patient is in a Contract Nursing Home !!"
DO DIR
IF '$GET(PSOQFLG)
SET PSORX("CNH")=1
+3 QUIT
+4 ;
ELIG IF $GET(PSOPTPST(2,PSODFN,.361))]""
IF $GET(PSOPTPST(2,PSODFN,.172))'="I"
WRITE !,"MAS Eligibility: "_PSOPTPST(2,PSODFN,.361)
+1 SET DFN=PSODFN
DO RE^PSODEM
+2 QUIT
+3 ;
COPAY KILL PSOBILL,PSOCPAY
SET DFN=PSODFN
SET (X,PSOPTIB)=$PIECE($GET(^PS(59,+PSOSITE,"IB")),"^")_"^"_PSODFN
DO XTYPE^IBARX
+1 IF '$DATA(^IBE(350.1,"ANEW",+PSOPTIB,1,1))
SET PSOQFLG=1
Begin DoDot:1
+2 WRITE $CHAR(7),!!,"There is a problem with the IB SERVICE/SECTION entry in your Pharmacy Site File."
+3 WRITE !,"You will not be able to enter any new prescriptions until this is corrected!",!
End DoDot:1
KILL PSOPTIB
QUIT
+4 SET (ACTYP,BL)=""
SET (PSOBILL,PSOCPAY)=0
IF +Y=-1
WRITE !,"ERROR IN COPAY ELIGIBILITY ENCOUNTERED."
GOTO COPAYX
COPAY1 SET ACTYP=$ORDER(Y(ACTYP))
IF 'ACTYP
GOTO COPAYX
FOR III=0:0
SET BL=$ORDER(Y(ACTYP,BL))
IF BL=""
QUIT
IF BL>0
SET PSOBILL=BL
SET PSOCPAY=BL_"^"_Y(ACTYP,BL)
+1 GOTO COPAY1
COPAYX KILL X,Y,ACTYP,BL,III,PSOPTIB
+1 ;I $G(PSOBILL)
+2 DO QST
+3 QUIT
+4 ;
ADDRESS NEW DFN
SET (DA,DFN)=PSODFN
DO ADD^VADPT
KILL DFN,PSOI,DA,DR
+1 QUIT
+2 ;
WRITE !!,?5
+1 FOR PSOI=1:1
IF $PIECE(PSOX," ",PSOI,900)=""
QUIT
IF $X+$LENGTH($PIECE(PSOX," ",PSOI))+$LENGTH(" ")>IOM
WRITE !?5
WRITE $PIECE(PSOX," ",PSOI)_" "
+2 KILL PSOX,PSOI
+3 QUIT
+4 ;
INSUR ; IHS/CIA/PLS - 01/06/04 - Display Insurance Information
+1 NEW IORVON,IORVOFF,IOBON,IOBOFF,MCR
+2 SET X="IORVON;IORVOFF;IOBON;IOBOFF"
DO ENDR^%ZISS
+3 IF $$MCD^APSQPINS($SELECT($DATA(PSODFN):PSODFN,$DATA(DFN):DFN,1:""),DT)
Begin DoDot:1
+4 WRITE !,?30,IORVON,IOBON,"MEDICAID PATIENT"_"*"_$$GP^APSQPINS($$MCD^APSQPINS($SELECT($DATA(PSODFN):PSODFN,$DATA(DFN):DFN,1:""),DT))_"*"_IORVOFF,IOBOFF
+5 FOR I=1:1:2
WRITE *7," "
End DoDot:1
+6 SET MCR=$$MCR^APSQPINS($SELECT($DATA(PSODFN):PSODFN,$DATA(DFN):DFN,1:""),DT)
+7 IF MCR
Begin DoDot:1
+8 ;IHS/MSC/PLS - 08/30/06 Added Plan Name
WRITE !,?30,IORVON,IOBON,"MEDICARE PATIENT - "_$$GET1^DIQ(9999999.18,+$PIECE(MCR,U,2),.01)_" - "_$SELECT(MCR:"Grace Period: "_$$GP^APSQPINS(+MCR),1:"No Data"),IORVOFF,IOBOFF
+9 FOR I=1:1:2
WRITE *7," "
End DoDot:1
+10 IF $$PIN^APSQPINS($SELECT($DATA(PSODFN):PSODFN,$DATA(DFN):DFN,1:""),DT,"E")]""
Begin DoDot:1
+11 WRITE !,?10,IORVON,IOBON,$$PIN^APSQPINS($SELECT($DATA(PSODFN):PSODFN,$DATA(DFN):DFN,1:""),DT,"E"),!,IORVOFF,IOBOFF
+12 FOR I=1:1:2
WRITE *7," "
End DoDot:1
+13 QUIT
+14 ;
CAP ; IHS/CIA/PLS - 01/06/04 - Display Safety Status for Bottles
+1 NEW X,Y,IORVON,IORVOFF
+2 SET Y=$$GET1^DIQ(55,PSODFN_",",.02,"I")
+3 IF Y
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
+4 WRITE ?($X+2),"CAP STATUS: ",$SELECT(Y=0:"SAFETY CAPS OK",Y=1:IORVON_"NON SAFETY CAPS REQUESTED"_IORVOFF,1:"UNKNOWN STATUS")
+5 QUIT
DIR KILL DIR
WRITE !
+1 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do You Want To Continue"
DO ^DIR
KILL DIR
+2 IF 'Y
SET PSOQFLG=1
KILL X,Y,DIRUT,DTOUT,DUOUT
+3 QUIT
+4 ;
EOJ IF PSOQFLG
KILL PSORX("CNH")
KILL PSOPTPST,VAPA
+1 QUIT
QST ;Ask new questions for Copay
+1 IF '$$DT^PSOMLLDT
QUIT
+2 KILL PSOIBQS
+3 IF $GET(PSOBILL)
SET PSOIBQS(PSODFN,"SC")=""
+4 SET PSOIBQS(PSODFN,"SC>50")=""
+5 ;IHS/MSC/PLS - 2/13/07 - Next line commented out because of NOROUTINE error
+6 ;I +$P($$CVEDT^DGCV(PSODFN),"^",3) S PSOIBQS(PSODFN,"CV")=""
+7 IF $$AO^SDCO22(PSODFN)
SET PSOIBQS(PSODFN,"VEH")=""
+8 IF $$IR^SDCO22(PSODFN)
SET PSOIBQS(PSODFN,"RAD")=""
+9 IF $$EC^SDCO22(PSODFN)
SET PSOIBQS(PSODFN,"PGW")=""
+10 IF $LENGTH($TEXT(GETSHAD^DGUTL3))
IF $$GETSHAD^DGUTL3(PSODFN)=1
SET PSOIBQS(PSODFN,"SHAD")=""
+11 IF $PIECE($$GETSTAT^DGMSTAPI(PSODFN),"^",2)="Y"
SET PSOIBQS(PSODFN,"MST")=""
+12 IF $TEXT(GETCUR^DGNTAPI)]""
NEW PSONCP,PSONCPX
SET PSONCPX=$$GETCUR^DGNTAPI(PSODFN,"PSONCP")
IF $PIECE($GET(PSONCP("IND")),"^")="Y"
SET PSOIBQS(PSODFN,"HNC")=""
+13 QUIT
