- PSSDDUT3 ;BIR/LDT-Pharmacy Data Management DD Utility ; 09/17/97 14:35
- ;;1.0;PHARMACY DATA MANAGEMENT;**35,171**;9/30/97;Build 19
- ;
- ; Reference to ENSD^PSGNE3 is supported by DBIA #2150.
- ; Reference to EN^PSGCT is supported by DBIA #2146.
- ; Reference to ENT^PSIVWL is supported by DBIA #2154.
- ;
- ADTM ;UNIT DOSE MULTIPLE of PHARMACY PATIENT file (55) field 41
- S PSSHLP(1)="THE TIMES MUST BE TWO (2) OR FOUR (4) DIGITS, SEPARATED WITH"
- S PSSHLP(2)="DASHES ('-'), AND BE IN ASCENDING ORDER. (IE. 01-05-13)"
- D WRITE
- Q
- ;
- SPCIN ;UNIT DOSE MULTIPLE of PHARMACY PATIENT file (55) field 8
- S PSSHLP(1)="IF ABBREVIATIONS ARE USED, THE TOTAL LENGTH OF THE EXPANDED"
- S PSSHLP(2)="INSTRUCTIONS ALSO MAY NOT EXCEED 180 CHARACTERS."
- D WRITE
- Q
- ;
- SCHTP ;Called from the Unit Dose Multiple of file 55, Schedule Type field 7
- S PSSHLP(1)="CHOOSE FROM:"
- S PSSHLP(1,"F")="!!"
- S PSSHLP(2)="C - CONTINUOUS"
- S PSSHLP(2,"F")="!?3"
- S PSSHLP(3)="O - ONE-TIME"
- S PSSHLP(3,"F")="!?3"
- S PSSHLP(4)="OC - ON CALL"
- S PSSHLP(4,"F")="!?3"
- S PSSHLP(5)="P - PRN"
- S PSSHLP(5,"F")="!?3"
- S PSSHLP(6)="R - FILL ON REQUEST"
- S PSSHLP(6,"F")="!?3"
- D WRITE
- Q
- ;
- CHKSI ;Called from Unit Dose Multiple of file (55), Special Instructions
- ;field 8 (Replaces ^PSGSICHK)
- I $S(X'?.ANP:1,X["^":1,1:$L(X)>180) K X Q
- N Y S Y="" F Y(1)=1:1:$L(X," ") S Y(2)=$P(X," ",Y(1)) I Y(2)]"" D CHK1 Q:'$D(X)
- I $D(X),Y]"",X'=$E(Y,1,$L(Y)-1) D EN^DDIOL("EXPANDS TO:","","!?3") F Y(1)=1:1 S Y(2)=$P(Y," ",Y(1)) Q:Y(2)="" D:$L(Y(2))+$X>78 EN^DDIOL("","","!") D EN^DDIOL(Y(2)_" ","","?0")
- K Y Q
- CHK1 ;
- I $L(Y(2))<31,$D(^PS(51,+$O(^PS(51,"B",Y(2),0)),0)),$P(^(0),"^",2)]"",$P(^(0),"^",4) S Y(2)=$P(^(0),"^",2)
- I $L(Y)+$L(Y(2))>180 K X Q
- S Y=Y_Y(2)_" " Q
- ;
- EN2 ;Called from Unit Dose multiple of file 55, STOP DATE/TIME field 34
- ;Replaces EN2^PSGDL
- K PSGDLS S ND2=^PS(55,DA(1),5,DA,2) I '$P(ND2,"^",5),'$P(ND2,"^",6) G DONE
- D EN^DDIOL(" ...Dose Limit... ","","?0")
- ;
- ENGO ;
- S SCH=$P(ND2,"^")
- S ST=$S($D(PSGDLS):PSGDLS,1:$P(ND2,"^",2))
- S TS=$P(ND2,"^",5),MN=$P(ND2,"^",6)
- I $P(PSJSYSW0,U,5)=2 D
- . S $P(PSJSYSW0,U,5)=1
- . S X="PSGNE3" X ^%ZOSF("TEST") I S ST=$$ENSD^PSGNE3(ST,TS,ST,"")
- . S $P(PSJSYSW0,U,5)=2
- G MWF:SCH["@",DONE:'TS&'MN
- I 'TS S X="PSGCT" X ^%ZOSF("TEST") I S AM=MN*PSGDL,X=$$EN^PSGCT(ST,AM) G DONE
- S TM=$E(ST_"00000",9,8+$L($P(TS,"-")))
- F Q=1:1 Q:$P(TS,"-",Q)=""!(TM<$P(TS,"-",Q))
- S X=ST\1,C=0 F Q=Q:1 D:$P(TS,"-",Q)="" ADD S C=C+1 I C=PSGDL S X=X_"."_$P(TS,"-",Q) G DONE
- ;
- MWF ; if schedule is similar to monday-wednesday-friday
- S TS=$P(SCH,"@",2),SCH=$P(SCH,"@"),X=$P(ST,"."),C=0 D SCHK G:C=PSGDL DONE F Q=1:1 S X1=$P(ST,"."),X2=Q D C^%DTC S X1=X D DW^%DTC D CHK G:C=PSGDL DONE
- SCHK S X1=X D DW^%DTC F Q=1:1:$L(SCH,"-") S WKD=$P(SCH,"-",Q) I WKD=$E(X,1,$L(WKD)) Q
- E Q
- S TM=$E(ST_"00000",9,8+$L($P(TS,"-"))) F Q=1:1:$L(TS,"-") I TM<$P(TS,"-",Q) S C=C+1 I C=PSGDL S X=X1_"."_$P(TS,"-",Q) Q
- Q
- CHK F QQ=1:1:$L(SCH,"-") S WKD=$P(SCH,"-",QQ) I WKD=$E(X,1,$L(WKD)) D TS Q
- Q
- TS F Q1=1:1:$L(TS,"-") S C=C+1 I C=PSGDL S X=X1_"."_$P(TS,"-",Q1) Q
- Q
- ;
- DONE ;
- K %H,%T,%Y,MN,ND2,ND4,PSGDLS,PSGDL,Q1,QQ,SCH,TM,WKD,TS,X1,X2 Q
- ;
- ADD ;
- S X1=$P(X,"."),X2=$S(MN&'(MN#1440):MN\1440,1:1) D C^%DTC S Q=1 Q
- ;
- ENDL ;From DD(55.01,.03,0) Replaces call ENDL^PSIVSP
- D EN^DDIOL(" Dose limit .... ","","?0") S PSIVMIN=P(15)*X,PSIVSD=+P(2)
- I PSIVMIN<0 D EN^DDIOL(" --- There is something wrong with this order !!","","!!") D EN^DDIOL(" Call inpatient supervisor .....") S Y=-1 K PSIVMIN Q
- I P(4)="P"!(P(5))!(P(23)="P"),PSIVMIN=0,"^NOW^STAT^ONCE^"'[("^"_$P(P(9)," ")_"^") D DLP G QDL
- S X="PSIVWL" X ^%ZOSF("TEST") I D ENT^PSIVWL
- QDL I $D(X) S X=Y X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) S Y=X
- Q
- DLP ;
- S X=X+1,$P(PSIVSD,".",2)=$P(PSIVSD,".",2)_$E("0000",1,4-$L($P(PSIVSD,".",2))) D CHK3 S X2=0,Y=1 I X<2 S Y=+PSIVSD G QDLP
- I $P(PSIVSD,".",2)>$P(P(11),"-",$L(P(11),"-")) S X2=1 G OV
- G:$P(P(11),"-")>$P(PSIVSD,".",2) OV
- F Y=1:1 S X1=$P(P(11),"-",Y) I X1=$P(PSIVSD,".",2)!($P(PSIVSD,".",2)<X1) Q
- OV I P(11)="" D EN^DDIOL(" ???","","$C(7)") D EN^DDIOL("*** You have not defined any administration times !!","","!?15") K X Q
- F Y=Y:1 S:$P(P(11),"-",Y)="" X2=X2+1,Y=0,X=X+1 S X=X-1 Q:X<1
- S X=PSIVSD\1 I X2>0 S X1=PSIVSD D C^%DTC S X=$P(X,".") ; install with version 17.3 of fileman
- S Y=+(X_"."_$P(P(11),"-",Y))
- QDLP K X1,X2 Q
- ;
- ENI ;^DD(555.01,.03,0)
- K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X)!'$D(P(4)) Q
- I P(4)="P"!(P(5))!(P(23)="P") Q:'X S X="INFUSE OVER "_X_" MIN." D EN^DDIOL(" "_X,"","?0") Q
- I X'=+X,($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)) K X Q
- S SPSOL=$O(DRG("SOL",0)) I 'SPSOL K SPSOL,X D EN^DDIOL(" You must define at least one solution !!","","?0") Q
- I X=+X S X=X_" ml/hr" D EN^DDIOL(" ml/hr","","?0") D SPSOL S P(15)=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q
- S SPSOL=$P(X,"@",2) S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr" D EN^DDIOL(" "_+SPSOL_" Label"_$S(SPSOL'=1:"s",1:"")_" per day","","?0") D EN^DDIOL("at an infusion rate of: "_$P(X,"@"),"","!?15") S P(15)=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL
- Q
- SPSOL S SPSOL=0 F XXX=0:0 S XXX=$O(DRG("SOL",XXX)) Q:'XXX S SPSOL=SPSOL+$P(DRG("SOL",XXX),U,3)
- K XXX Q
- CHK3 F Y=1:1 Q:$L(P(11))>240!($P(P(11),"-",Y)="") S $P(P(11),"-",Y)=$P(P(11),"-",Y)_$E("0000",1,4-$L($P(P(11),"-",Y)))
- Q
- ;
- WRITE ;Calls EN^DDIOL to write text
- D EN^DDIOL(.PSSHLP) K PSSHLP Q
- Q
- ;
- AASCRN(PSSREC) ; Screen the RECOMMENDATION field (#.08) in APSPQA INTERVENTION file
- ; Input : PSSREC - IEN of APSP INTERVENTION RECOMMENDATION file (#9009032.5) entry
- ; Output : FALSE - Filter out 'UNABLE TO ASSESS' recommendations if not a NO ALLERGY ASSESSMENT intervention type,
- ; filter out all recommendation except 'OTHER' and 'UNABLE TO ASSESS' if not a NO ALLERGY ASSESSMENT intervention type
- ; Output : TRUE - Include only 'UNABLE TO ASSESS' and 'OTHER' recommendations if working on a NO ALLERGY ASSESSMENT intervention type,
- ; include all recommendatons except 'UNABLE TO ASSESS' and 'OTHER' if not working on a NO ALLERGY ASSESSMENT intervention type
- I $G(^APSPQA(32.3,+$P($G(^APSPQA(32.4,+$G(DA),0)),"^",7),0))="NO ALLERGY ASSESSMENT" Q $S($G(^APSPQA(32.5,+$G(PSSREC),0))="UNABLE TO ASSESS":1,$G(^APSPQA(32.5,+$G(PSSREC),0))="OTHER":1,1:0)
- Q $S($G(^APSPQA(32.5,+$G(PSSREC),0))="UNABLE TO ASSESS":0,1:1)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDDUT3 6426 printed Feb 18, 2025@23:56:44 Page 2
- PSSDDUT3 ;BIR/LDT-Pharmacy Data Management DD Utility ; 09/17/97 14:35
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**35,171**;9/30/97;Build 19
- +2 ;
- +3 ; Reference to ENSD^PSGNE3 is supported by DBIA #2150.
- +4 ; Reference to EN^PSGCT is supported by DBIA #2146.
- +5 ; Reference to ENT^PSIVWL is supported by DBIA #2154.
- +6 ;
- ADTM ;UNIT DOSE MULTIPLE of PHARMACY PATIENT file (55) field 41
- +1 SET PSSHLP(1)="THE TIMES MUST BE TWO (2) OR FOUR (4) DIGITS, SEPARATED WITH"
- +2 SET PSSHLP(2)="DASHES ('-'), AND BE IN ASCENDING ORDER. (IE. 01-05-13)"
- +3 DO WRITE
- +4 QUIT
- +5 ;
- SPCIN ;UNIT DOSE MULTIPLE of PHARMACY PATIENT file (55) field 8
- +1 SET PSSHLP(1)="IF ABBREVIATIONS ARE USED, THE TOTAL LENGTH OF THE EXPANDED"
- +2 SET PSSHLP(2)="INSTRUCTIONS ALSO MAY NOT EXCEED 180 CHARACTERS."
- +3 DO WRITE
- +4 QUIT
- +5 ;
- SCHTP ;Called from the Unit Dose Multiple of file 55, Schedule Type field 7
- +1 SET PSSHLP(1)="CHOOSE FROM:"
- +2 SET PSSHLP(1,"F")="!!"
- +3 SET PSSHLP(2)="C - CONTINUOUS"
- +4 SET PSSHLP(2,"F")="!?3"
- +5 SET PSSHLP(3)="O - ONE-TIME"
- +6 SET PSSHLP(3,"F")="!?3"
- +7 SET PSSHLP(4)="OC - ON CALL"
- +8 SET PSSHLP(4,"F")="!?3"
- +9 SET PSSHLP(5)="P - PRN"
- +10 SET PSSHLP(5,"F")="!?3"
- +11 SET PSSHLP(6)="R - FILL ON REQUEST"
- +12 SET PSSHLP(6,"F")="!?3"
- +13 DO WRITE
- +14 QUIT
- +15 ;
- CHKSI ;Called from Unit Dose Multiple of file (55), Special Instructions
- +1 ;field 8 (Replaces ^PSGSICHK)
- +2 IF $SELECT(X'?.ANP:1,X["^":1,1:$LENGTH(X)>180)
- KILL X
- QUIT
- +3 NEW Y
- SET Y=""
- FOR Y(1)=1:1:$LENGTH(X," ")
- SET Y(2)=$PIECE(X," ",Y(1))
- IF Y(2)]""
- DO CHK1
- if '$DATA(X)
- QUIT
- +4 IF $DATA(X)
- IF Y]""
- IF X'=$EXTRACT(Y,1,$LENGTH(Y)-1)
- DO EN^DDIOL("EXPANDS TO:","","!?3")
- FOR Y(1)=1:1
- SET Y(2)=$PIECE(Y," ",Y(1))
- if Y(2)=""
- QUIT
- if $LENGTH(Y(2))+$X>78
- DO EN^DDIOL("","","!")
- DO EN^DDIOL(Y(2)_" ","","?0")
- +5 KILL Y
- QUIT
- CHK1 ;
- +1 IF $LENGTH(Y(2))<31
- IF $DATA(^PS(51,+$ORDER(^PS(51,"B",Y(2),0)),0))
- IF $PIECE(^(0),"^",2)]""
- IF $PIECE(^(0),"^",4)
- SET Y(2)=$PIECE(^(0),"^",2)
- +2 IF $LENGTH(Y)+$LENGTH(Y(2))>180
- KILL X
- QUIT
- +3 SET Y=Y_Y(2)_" "
- QUIT
- +4 ;
- EN2 ;Called from Unit Dose multiple of file 55, STOP DATE/TIME field 34
- +1 ;Replaces EN2^PSGDL
- +2 KILL PSGDLS
- SET ND2=^PS(55,DA(1),5,DA,2)
- IF '$PIECE(ND2,"^",5)
- IF '$PIECE(ND2,"^",6)
- GOTO DONE
- +3 DO EN^DDIOL(" ...Dose Limit... ","","?0")
- +4 ;
- ENGO ;
- +1 SET SCH=$PIECE(ND2,"^")
- +2 SET ST=$SELECT($DATA(PSGDLS):PSGDLS,1:$PIECE(ND2,"^",2))
- +3 SET TS=$PIECE(ND2,"^",5)
- SET MN=$PIECE(ND2,"^",6)
- +4 IF $PIECE(PSJSYSW0,U,5)=2
- Begin DoDot:1
- +5 SET $PIECE(PSJSYSW0,U,5)=1
- +6 SET X="PSGNE3"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET ST=$$ENSD^PSGNE3(ST,TS,ST,"")
- +7 SET $PIECE(PSJSYSW0,U,5)=2
- End DoDot:1
- +8 if SCH["@"
- GOTO MWF
- if 'TS&'MN
- GOTO DONE
- +9 IF 'TS
- SET X="PSGCT"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET AM=MN*PSGDL
- SET X=$$EN^PSGCT(ST,AM)
- GOTO DONE
- +10 SET TM=$EXTRACT(ST_"00000",9,8+$LENGTH($PIECE(TS,"-")))
- +11 FOR Q=1:1
- if $PIECE(TS,"-",Q)=""!(TM<$PIECE(TS,"-",Q))
- QUIT
- +12 SET X=ST\1
- SET C=0
- FOR Q=Q:1
- if $PIECE(TS,"-",Q)=""
- DO ADD
- SET C=C+1
- IF C=PSGDL
- SET X=X_"."_$PIECE(TS,"-",Q)
- GOTO DONE
- +13 ;
- MWF ; if schedule is similar to monday-wednesday-friday
- +1 SET TS=$PIECE(SCH,"@",2)
- SET SCH=$PIECE(SCH,"@")
- SET X=$PIECE(ST,".")
- SET C=0
- DO SCHK
- if C=PSGDL
- GOTO DONE
- FOR Q=1:1
- SET X1=$PIECE(ST,".")
- SET X2=Q
- DO C^%DTC
- SET X1=X
- DO DW^%DTC
- DO CHK
- if C=PSGDL
- GOTO DONE
- SCHK SET X1=X
- DO DW^%DTC
- FOR Q=1:1:$LENGTH(SCH,"-")
- SET WKD=$PIECE(SCH,"-",Q)
- IF WKD=$EXTRACT(X,1,$LENGTH(WKD))
- QUIT
- +1 IF '$TEST
- QUIT
- +2 SET TM=$EXTRACT(ST_"00000",9,8+$LENGTH($PIECE(TS,"-")))
- FOR Q=1:1:$LENGTH(TS,"-")
- IF TM<$PIECE(TS,"-",Q)
- SET C=C+1
- IF C=PSGDL
- SET X=X1_"."_$PIECE(TS,"-",Q)
- QUIT
- +3 QUIT
- CHK FOR QQ=1:1:$LENGTH(SCH,"-")
- SET WKD=$PIECE(SCH,"-",QQ)
- IF WKD=$EXTRACT(X,1,$LENGTH(WKD))
- DO TS
- QUIT
- +1 QUIT
- TS FOR Q1=1:1:$LENGTH(TS,"-")
- SET C=C+1
- IF C=PSGDL
- SET X=X1_"."_$PIECE(TS,"-",Q1)
- QUIT
- +1 QUIT
- +2 ;
- DONE ;
- +1 KILL %H,%T,%Y,MN,ND2,ND4,PSGDLS,PSGDL,Q1,QQ,SCH,TM,WKD,TS,X1,X2
- QUIT
- +2 ;
- ADD ;
- +1 SET X1=$PIECE(X,".")
- SET X2=$SELECT(MN&'(MN#1440):MN\1440,1:1)
- DO C^%DTC
- SET Q=1
- QUIT
- +2 ;
- ENDL ;From DD(55.01,.03,0) Replaces call ENDL^PSIVSP
- +1 DO EN^DDIOL(" Dose limit .... ","","?0")
- SET PSIVMIN=P(15)*X
- SET PSIVSD=+P(2)
- +2 IF PSIVMIN<0
- DO EN^DDIOL(" --- There is something wrong with this order !!","","!!")
- DO EN^DDIOL(" Call inpatient supervisor .....")
- SET Y=-1
- KILL PSIVMIN
- QUIT
- +3 IF P(4)="P"!(P(5))!(P(23)="P")
- IF PSIVMIN=0
- IF "^NOW^STAT^ONCE^"'[("^"_$PIECE(P(9)," ")_"^")
- DO DLP
- GOTO QDL
- +4 SET X="PSIVWL"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- DO ENT^PSIVWL
- QDL IF $DATA(X)
- SET X=Y
- XECUTE ^DD("DD")
- WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2)
- SET Y=X
- +1 QUIT
- DLP ;
- +1 SET X=X+1
- SET $PIECE(PSIVSD,".",2)=$PIECE(PSIVSD,".",2)_$EXTRACT("0000",1,4-$LENGTH($PIECE(PSIVSD,".",2)))
- DO CHK3
- SET X2=0
- SET Y=1
- IF X<2
- SET Y=+PSIVSD
- GOTO QDLP
- +2 IF $PIECE(PSIVSD,".",2)>$PIECE(P(11),"-",$LENGTH(P(11),"-"))
- SET X2=1
- GOTO OV
- +3 if $PIECE(P(11),"-")>$PIECE(PSIVSD,".",2)
- GOTO OV
- +4 FOR Y=1:1
- SET X1=$PIECE(P(11),"-",Y)
- IF X1=$PIECE(PSIVSD,".",2)!($PIECE(PSIVSD,".",2)<X1)
- QUIT
- OV IF P(11)=""
- DO EN^DDIOL(" ???","","$C(7)")
- DO EN^DDIOL("*** You have not defined any administration times !!","","!?15")
- KILL X
- QUIT
- +1 FOR Y=Y:1
- if $PIECE(P(11),"-",Y)=""
- SET X2=X2+1
- SET Y=0
- SET X=X+1
- SET X=X-1
- if X<1
- QUIT
- +2 ; install with version 17.3 of fileman
- SET X=PSIVSD\1
- IF X2>0
- SET X1=PSIVSD
- DO C^%DTC
- SET X=$PIECE(X,".")
- +3 SET Y=+(X_"."_$PIECE(P(11),"-",Y))
- QDLP KILL X1,X2
- QUIT
- +1 ;
- ENI ;^DD(555.01,.03,0)
- +1 if $LENGTH(X)<1!($LENGTH(X)>30)!(X["""")!($ASCII(X)=45)
- KILL X
- IF '$DATA(X)!'$DATA(P(4))
- QUIT
- +2 IF P(4)="P"!(P(5))!(P(23)="P")
- if 'X
- QUIT
- SET X="INFUSE OVER "_X_" MIN."
- DO EN^DDIOL(" "_X,"","?0")
- QUIT
- +3 IF X'=+X
- IF ($PIECE(X,"@",2,999)'=+$PIECE(X,"@",2,999)!(+$PIECE(X,"@",2,999)<0))
- KILL X
- QUIT
- +4 SET SPSOL=$ORDER(DRG("SOL",0))
- IF 'SPSOL
- KILL SPSOL,X
- DO EN^DDIOL(" You must define at least one solution !!","","?0")
- QUIT
- +5 IF X=+X
- SET X=X_" ml/hr"
- DO EN^DDIOL(" ml/hr","","?0")
- DO SPSOL
- SET P(15)=$SELECT('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1)
- KILL SPSOL
- QUIT
- +6 SET SPSOL=$PIECE(X,"@",2)
- if $PIECE(X,"@")=+X
- SET $PIECE(X,"@")=$PIECE(X,"@")_" ml/hr"
- DO EN^DDIOL(" "_+SPSOL_" Label"_$SELECT(SPSOL'=1:"s",1:"")_" per day","","?0")
- DO EN^DDIOL("at an infusion rate of: "_$PIECE(X,"@"),"","!?15")
- SET P(15)=$SELECT('SPSOL:0,1:1440/SPSOL\1)
- KILL SPSOL
- +7 QUIT
- SPSOL SET SPSOL=0
- FOR XXX=0:0
- SET XXX=$ORDER(DRG("SOL",XXX))
- if 'XXX
- QUIT
- SET SPSOL=SPSOL+$PIECE(DRG("SOL",XXX),U,3)
- +1 KILL XXX
- QUIT
- CHK3 FOR Y=1:1
- if $LENGTH(P(11))>240!($PIECE(P(11),"-",Y)="")
- QUIT
- SET $PIECE(P(11),"-",Y)=$PIECE(P(11),"-",Y)_$EXTRACT("0000",1,4-$LENGTH($PIECE(P(11),"-",Y)))
- +1 QUIT
- +2 ;
- WRITE ;Calls EN^DDIOL to write text
- +1 DO EN^DDIOL(.PSSHLP)
- KILL PSSHLP
- QUIT
- +2 QUIT
- +3 ;
- AASCRN(PSSREC) ; Screen the RECOMMENDATION field (#.08) in APSPQA INTERVENTION file
- +1 ; Input : PSSREC - IEN of APSP INTERVENTION RECOMMENDATION file (#9009032.5) entry
- +2 ; Output : FALSE - Filter out 'UNABLE TO ASSESS' recommendations if not a NO ALLERGY ASSESSMENT intervention type,
- +3 ; filter out all recommendation except 'OTHER' and 'UNABLE TO ASSESS' if not a NO ALLERGY ASSESSMENT intervention type
- +4 ; Output : TRUE - Include only 'UNABLE TO ASSESS' and 'OTHER' recommendations if working on a NO ALLERGY ASSESSMENT intervention type,
- +5 ; include all recommendatons except 'UNABLE TO ASSESS' and 'OTHER' if not working on a NO ALLERGY ASSESSMENT intervention type
- +6 IF $GET(^APSPQA(32.3,+$PIECE($GET(^APSPQA(32.4,+$GET(DA),0)),"^",7),0))="NO ALLERGY ASSESSMENT"
- QUIT $SELECT($GET(^APSPQA(32.5,+$GET(PSSREC),0))="UNABLE TO ASSESS":1,$GET(^APSPQA(32.5,+$GET(PSSREC),0))="OTHER":1,1:0)
- +7 QUIT $SELECT($GET(^APSPQA(32.5,+$GET(PSSREC),0))="UNABLE TO ASSESS":0,1:1)
