PSGIU ;BIR/CML3-GENERIC "APPLICATION PACKAGES' USE" SET ;16 SEP 97 / 9:22 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
EN ;
Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,PSIUX'?1E1"^"1.E:1,1:'$D(^PSDRUG(PSIUDA,0))) S PSIUO=$P($G(^(2)),"^",3) S PSIUT=$P(PSIUX,"^",2),PSIUT=$S($E(PSIUT,1,4)="UNIT":"",1:$E("N","AEIOU"[$E(PSIUT)))_" "_PSIUT,(%,PSIUQ)=PSIUO'[$E(PSIUX)+1
F W !!,"A",PSIUT," ITEM" D YN^DICN Q:% D MQ S %=PSIUQ
I %<0 S PSIUA="^" G DONE
S PSIUA=$E("YN",%) G:%=PSIUQ DONE I %=1 S PSIUY=PSIUO_$P(PSIUX,"^"),$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY I $P(^(0),"^")]"" S ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)=""
I %=2 S PSIUY=$P(PSIUO,$P(PSIUX,"^"))_$P(PSIUO,$P(PSIUX,"^"),2),$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY I $P(^(0),"^")]"" K ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)
K:PSIUO]"" ^PSDRUG("IU",PSIUO,PSIUDA) S:PSIUY]"" ^PSDRUG("IU",PSIUY,PSIUDA)=""
;
DONE ;
K PSIU,PSIUO,PSIUQ,PSIUT,PSIUY Q
;
MQ ;
S X="Enter 'YES' (or 'Y') to mark this drug as a"_$S($E(PSIUT,1,2)="N ":"n"_$E(PSIUT,2,99),1:PSIUT)_" item. Enter 'NO' (or 'N') to not mark (or unmark) this drug."
W !!?2 F PSIU=1:1:$L(X," ") S Y=$P(X," ",PSIU) W:$X+$L(Y)>79 ! W Y," "
Q
;
ENS ;
Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,'PSIUDA:1,$L($P(PSIUX,"^"))'=1:1,1:'$D(^PSDRUG(PSIUDA,0))) S PSIU=$P(^(0),"^"),(PSIUO,PSIUY)=$P($G(^(2)),"^",3),PSIUT=$P(PSIUX,"^")
I PSIUY'[PSIUT S PSIUY=PSIUY_PSIUT,$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY K:PSIUO]"" ^PSDRUG("IU",PSIUO,PSIUDA)
S ^PSDRUG("IU",PSIUY,PSIUDA)="" I PSIU]"" S ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)=""
G DONE
;
END ;
Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,'PSIUDA:1,$L($P(PSIUX,"^"))'=1:1,1:'$D(^PSDRUG(PSIUDA,0))) S PSIU=$P(^(0),"^"),(PSIUO,PSIUY)=$P($G(^(2)),"^",3),PSIUT=$P(PSIUX,"^")
I PSIUY[PSIUT S PSIUY=$P(PSIUY,PSIUT)_$P(PSIUY,PSIUT,2),$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY K ^PSDRUG("IU",PSIUO,PSIUDA)
S:PSIUY]"" ^PSDRUG("IU",PSIUY,PSIUDA)="" I PSIU]"" K ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)
G DONE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGIU 1949 printed Oct 16, 2024@18:02:06 Page 2
PSGIU ;BIR/CML3-GENERIC "APPLICATION PACKAGES' USE" SET ;16 SEP 97 / 9:22 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
EN ;
+1 if $SELECT('$DATA(PSIUDA)
QUIT
SET PSIUO=$PIECE($GET(^(2)),"^",3)
SET PSIUT=$PIECE(PSIUX,"^",2)
SET PSIUT=$SELECT($EXTRACT(PSIUT,1,4)="UNIT":"",1:$EXTRACT("N","AEIOU"[$EXTRACT(PSIUT)))_" "_PSIUT
SET (%,PSIUQ)=PSIUO'[$EXTRACT(PSIUX)+1
+2 FOR
WRITE !!,"A",PSIUT," ITEM"
DO YN^DICN
if %
QUIT
DO MQ
SET %=PSIUQ
+3 IF %<0
SET PSIUA="^"
GOTO DONE
+4 SET PSIUA=$EXTRACT("YN",%)
if %=PSIUQ
GOTO DONE
IF %=1
SET PSIUY=PSIUO_$PIECE(PSIUX,"^")
SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
IF $PIECE(^(0),"^")]""
SET ^PSDRUG("AIU"_$PIECE(PSIUX,"^"),$PIECE(^(0),"^"),PSIUDA)=""
+5 IF %=2
SET PSIUY=$PIECE(PSIUO,$PIECE(PSIUX,"^"))_$PIECE(PSIUO,$PIECE(PSIUX,"^"),2)
SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
IF $PIECE(^(0),"^")]""
KILL ^PSDRUG("AIU"_$PIECE(PSIUX,"^"),$PIECE(^(0),"^"),PSIUDA)
+6 if PSIUO]""
KILL ^PSDRUG("IU",PSIUO,PSIUDA)
if PSIUY]""
SET ^PSDRUG("IU",PSIUY,PSIUDA)=""
+7 ;
DONE ;
+1 KILL PSIU,PSIUO,PSIUQ,PSIUT,PSIUY
QUIT
+2 ;
MQ ;
+1 SET X="Enter 'YES' (or 'Y') to mark this drug as a"_$SELECT($EXTRACT(PSIUT,1,2)="N ":"n"_$EXTRACT(PSIUT,2,99),1:PSIUT)_" item. Enter 'NO' (or 'N') to not mark (or unmark) this drug."
+2 WRITE !!?2
FOR PSIU=1:1:$LENGTH(X," ")
SET Y=$PIECE(X," ",PSIU)
if $X+$LENGTH(Y)>79
WRITE !
WRITE Y," "
+3 QUIT
+4 ;
ENS ;
+1 if $SELECT('$DATA(PSIUDA)
QUIT
SET PSIU=$PIECE(^(0),"^")
SET (PSIUO,PSIUY)=$PIECE($GET(^(2)),"^",3)
SET PSIUT=$PIECE(PSIUX,"^")
+2 IF PSIUY'[PSIUT
SET PSIUY=PSIUY_PSIUT
SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
if PSIUO]""
KILL ^PSDRUG("IU",PSIUO,PSIUDA)
+3 SET ^PSDRUG("IU",PSIUY,PSIUDA)=""
IF PSIU]""
SET ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)=""
+4 GOTO DONE
+5 ;
END ;
+1 if $SELECT('$DATA(PSIUDA)
QUIT
SET PSIU=$PIECE(^(0),"^")
SET (PSIUO,PSIUY)=$PIECE($GET(^(2)),"^",3)
SET PSIUT=$PIECE(PSIUX,"^")
+2 IF PSIUY[PSIUT
SET PSIUY=$PIECE(PSIUY,PSIUT)_$PIECE(PSIUY,PSIUT,2)
SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
KILL ^PSDRUG("IU",PSIUO,PSIUDA)
+3 if PSIUY]""
SET ^PSDRUG("IU",PSIUY,PSIUDA)=""
IF PSIU]""
KILL ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)
+4 GOTO DONE
