PSNSTCK ;BIR/CCH&WRT-size and type check ; 02/01/99 7:29
;;4.0; NATIONAL DRUG FILE;**5**; 30 Oct 98
;
; reference to ^PSDRUG supported by IA# 221
;
K LIST,^TMP($J,"PSNPSPS"),^TMP($J,"PSNDFPK") S PSNARY=0,DDD=$O(^PS(50.609,"B","OTHER",0)),EEE=$O(^PS(50.608,"B","OTHER",0)) D PACKAGE,ARR0,SIZE
K DDD,EEE,FFF,GGG
Q
PACKAGE S PSNFORM=$P(^PSNDF(50.68,PSNFNM,0),"^")
S K=PSNFNM,X=$$PSPT^PSNAPIS(,K,.LIST) S PTPS="" F S PTPS=$O(LIST(PTPS)) Q:'PTPS S XX=LIST(PTPS) F ST=1:1:X S ^TMP($J,"PSNPSPS",$P(XX,"^",2),$P(XX,"^",4))=$P(XX,"^",1)_"^"_$P(XX,"^",3),^TMP($J,"PSNPSPS","OTHER","OTHER")=DDD_"^"_EEE
Q
SIZE ; Pick Size & Type Combo
R !?10,"Enter Package Size & Type Combination: ",ANS:DTIME S:'$T ANS="^" I ANS["^" S PSNFL=1 Q
I ANS["?" D SZ1^PSNHELP K ANS G SIZE
I ANS="" S PSNSIZE=$O(^PS(50.609,"B","OTHER",0)),PSNTYPE=$O(^PS(50.608,"B","OTHER",0)) G ASK
I '$D(^TMP($J,"PSNDFPK",ANS)) W !,"Invalid Answer" G SIZE
G:'$D(^TMP($J,"PSNDFPK",ANS)) SIZE S FFF=$O(^TMP($J,"PSNDFPK",ANS,0)),GGG=$O(^TMP($J,"PSNDFPK",ANS,FFF,0)),PSNSZ=$P(^TMP($J,"PSNDFPK",ANS,FFF,GGG),"^"),PSNTYP=$P(^TMP($J,"PSNDFPK",ANS,FFF,GGG),"^",2),PSNSIZE=PSNSZ,PSNTYPE=PSNTYP
ASK D PKSIZE^PSNOUT,PKTYPE^PSNOUT W !!,"Local drug ",$P(^PSDRUG(PSNB,0),"^",1),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
W !!,"< Enter ""Y"" for yes >"
W !,"< Enter ""N"" for no >"
W:'$D(Z9) !,"< Press return for next drug or ""^"" to quit>"
W ?50 R "OK? : ",ANS:DTIME S:'$T ANS="^" I ANS']"" W ?60,"Drug not matched" S:$D(Z9) PSNFL=1 Q
I "Nn"[$E(ANS) G @PSNVAR
I ANS["^" S PSNFL=1 Q
I "YNyn"'[$E(ANS) D ASK1^PSNHELP G ASK
Q
ARR0 W !,"CHOOSE FROM: " S PP="" F S PP=$O(^TMP($J,"PSNPSPS",PP)) Q:PP="" S QQ="" F S QQ=$O(^TMP($J,"PSNPSPS",PP,QQ)) Q:QQ="" S RR=^TMP($J,"PSNPSPS",PP,QQ) D ARR1
Q
ARR1 S PSNARY=PSNARY+1 S ^TMP($J,"PSNDFPK",PSNARY,PP,QQ)=RR W !?2,PSNARY," ",PP," ",QQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNSTCK 1915 printed Oct 16, 2024@18:25:43 Page 2
PSNSTCK ;BIR/CCH&WRT-size and type check ; 02/01/99 7:29
+1 ;;4.0; NATIONAL DRUG FILE;**5**; 30 Oct 98
+2 ;
+3 ; reference to ^PSDRUG supported by IA# 221
+4 ;
+5 KILL LIST,^TMP($JOB,"PSNPSPS"),^TMP($JOB,"PSNDFPK")
SET PSNARY=0
SET DDD=$ORDER(^PS(50.609,"B","OTHER",0))
SET EEE=$ORDER(^PS(50.608,"B","OTHER",0))
DO PACKAGE
DO ARR0
DO SIZE
+6 KILL DDD,EEE,FFF,GGG
+7 QUIT
PACKAGE SET PSNFORM=$PIECE(^PSNDF(50.68,PSNFNM,0),"^")
+1 SET K=PSNFNM
SET X=$$PSPT^PSNAPIS(,K,.LIST)
SET PTPS=""
FOR
SET PTPS=$ORDER(LIST(PTPS))
if 'PTPS
QUIT
SET XX=LIST(PTPS)
FOR ST=1:1:X
SET ^TMP($JOB,"PSNPSPS",$PIECE(XX,"^",2),$PIECE(XX,"^",4))=$PIECE(XX,"^",1)_"^"_$PIECE(XX,"^",3)
SET ^TMP($JOB,"PSNPSPS","OTHER","OTHER")=DDD_"^"_EEE
+2 QUIT
SIZE ; Pick Size & Type Combo
+1 READ !?10,"Enter Package Size & Type Combination: ",ANS:DTIME
if '$TEST
SET ANS="^"
IF ANS["^"
SET PSNFL=1
QUIT
+2 IF ANS["?"
DO SZ1^PSNHELP
KILL ANS
GOTO SIZE
+3 IF ANS=""
SET PSNSIZE=$ORDER(^PS(50.609,"B","OTHER",0))
SET PSNTYPE=$ORDER(^PS(50.608,"B","OTHER",0))
GOTO ASK
+4 IF '$DATA(^TMP($JOB,"PSNDFPK",ANS))
WRITE !,"Invalid Answer"
GOTO SIZE
+5 if '$DATA(^TMP($JOB,"PSNDFPK",ANS))
GOTO SIZE
SET FFF=$ORDER(^TMP($JOB,"PSNDFPK",ANS,0))
SET GGG=$ORDER(^TMP($JOB,"PSNDFPK",ANS,FFF,0))
SET PSNSZ=$PIECE(^TMP($JOB,"PSNDFPK",ANS,FFF,GGG),"^")
SET PSNTYP=$PIECE(^TMP($JOB,"PSNDFPK",ANS,FFF,GGG),"^",2)
SET PSNSIZE=PSNSZ
SET PSNTYPE=PSNTYP
ASK DO PKSIZE^PSNOUT
DO PKTYPE^PSNOUT
WRITE !!,"Local drug ",$PIECE(^PSDRUG(PSNB,0),"^",1),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
+1 WRITE !!,"< Enter ""Y"" for yes >"
+2 WRITE !,"< Enter ""N"" for no >"
+3 if '$DATA(Z9)
WRITE !,"< Press return for next drug or ""^"" to quit>"
+4 WRITE ?50
READ "OK? : ",ANS:DTIME
if '$TEST
SET ANS="^"
IF ANS']""
WRITE ?60,"Drug not matched"
if $DATA(Z9)
SET PSNFL=1
QUIT
+5 IF "Nn"[$EXTRACT(ANS)
GOTO @PSNVAR
+6 IF ANS["^"
SET PSNFL=1
QUIT
+7 IF "YNyn"'[$EXTRACT(ANS)
DO ASK1^PSNHELP
GOTO ASK
+8 QUIT
ARR0 WRITE !,"CHOOSE FROM: "
SET PP=""
FOR
SET PP=$ORDER(^TMP($JOB,"PSNPSPS",PP))
if PP=""
QUIT
SET QQ=""
FOR
SET QQ=$ORDER(^TMP($JOB,"PSNPSPS",PP,QQ))
if QQ=""
QUIT
SET RR=^TMP($JOB,"PSNPSPS",PP,QQ)
DO ARR1
+1 QUIT
ARR1 SET PSNARY=PSNARY+1
SET ^TMP($JOB,"PSNDFPK",PSNARY,PP,QQ)=RR
WRITE !?2,PSNARY," ",PP," ",QQ
+1 QUIT
