- 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 Feb 18, 2025@23:51:18 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