PSBOAL ;BIRMINGHAM/EFC-BCMA UTILITIES ;08/09/17 10:19
;;3.0;BAR CODE MED ADMIN;**93**;Mar 2004;Build 111
;
; Reference/IA
; ^GMRADPT/10099
; ^GMRAOR2/2422
EN ;
N PSBLIST,PSBGBL,DFN
S PSBGBL="^TMP(""PSBO"",$J,""B"")"
F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'=$J Q:$QS(PSBGBL,1)'["PSBO" D
.S DFN=$QS(PSBGBL,5)
.D EN1
K ^TMP("PSBO",$J)
Q
;
EN1 ;
S GMRA="0^0^111" S PSBLIST=""
D EN1^GMRADPT
F S PSBLIST=$O(GMRAL(PSBLIST)) Q:'PSBLIST D
.K PSBARRY
.D EN1^GMRAOR2(PSBLIST,"PSBARRY")
.W !,""
.W !," Causative agent : "_$P(PSBARRY,U)
.W !," Nature of Reaction : "_$S($P(PSBARRY,U,6)="ALLERGY":"Allergy",$P(PSBARRY,U,6)="PHARMACOLOGIC":"Adverse Reaction",$P(PSBARRY,U,6)="UNKNOWN":"Unknown",1:"") ;93
.W !,""
.I $D(PSBARRY("S",1)) D SYMP
.I $D(PSBARRY("V",1)) D CLAS
.W !," Originator : "_$P(PSBARRY,U,2)_$S($L($P(PSBARRY,U,3)):" ("_$P(PSBARRY,U,3)_")",1:"") ;93
.W !," Originated : "_$P(PSBARRY,U,10) ;93
.W !
.W !," Verified : "_$S($P(PSBARRY,U,4)="VERIFIED":"Yes",1:"No")
.W !," Observed/Historical : "_$S($P(PSBARRY,U,5)="OBSERVED":"Observed",$P(PSBARRY,U,5)="HISTORICAL":"Historical",1:"")
.;W !
.I $D(PSBARRY("O",1)) D OBS ;93
.I $D(PSBARRY("C",1)) D COM ;93
.W !
.W !," ******************************************"
Q
;
SYMP ;
S K=0,N=0 F S K=$O(PSBARRY("S",K)) Q:K'>0 D
.I N=0 W !," Signs/symptoms : "_PSBARRY("S",K)
.E W !," "_PSBARRY("S",K)
.S N=N+1
W !
K N,K
Q
CLAS ;
S K=0,N=0 F S K=$O(PSBARRY("V",K)) Q:K'>0 D
.I N=0 W !," Drug Classes : "_$P(PSBARRY("V",K),U,2)
.E W !," "_$P(PSBARRY("V",K),U,2) ;MOVED TO THE RIGHT
.S N=N+1
W !
K N,K
Q
OBS ;Display originator name ;added tag 93
N N,K,Y
S K=0,N=0 F S K=$O(PSBARRY("O",K)) Q:K'>0 D
.I N=0 D
..S Y=$P(PSBARRY("O",K),U) D DD^%DT
..W !," Date/Severity : "_Y_" "_$P(PSBARRY("O",K),U,2)
.E D
..S Y=$P(PSBARRY("O",K),U) D DD^%DT
..W !," "_Y_" "_$P(PSBARRY("O",K),U,2)
.S N=N+1
K N,K,Y
Q
COM ;display comments - tag added 93
N N,K,L,Y
S K=0,N=0,Y=0
W !
F S K=$O(PSBARRY("C",K)) Q:K'>0 D
.I N=0 W !," Comments :"
.S Y=$P(PSBARRY("C",K),U) D DD^%DT
.W " "_Y_" by "_$P(PSBARRY("C",K),U,2)
.I $D(PSBARRY("C",K,1,0)) S L=0 F S L=$O(PSBARRY("C",K,L)) Q:L'>0 D
.. W !," ",PSBARRY("C",K,L,0)
.S N=N+1
K N,K,L,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOAL 2540 printed Apr 09, 2024@20:44:44 Page 2
PSBOAL ;BIRMINGHAM/EFC-BCMA UTILITIES ;08/09/17 10:19
+1 ;;3.0;BAR CODE MED ADMIN;**93**;Mar 2004;Build 111
+2 ;
+3 ; Reference/IA
+4 ; ^GMRADPT/10099
+5 ; ^GMRAOR2/2422
EN ;
+1 NEW PSBLIST,PSBGBL,DFN
+2 SET PSBGBL="^TMP(""PSBO"",$J,""B"")"
+3 FOR
SET PSBGBL=$QUERY(@PSBGBL)
if PSBGBL=""
QUIT
if $QSUBSCRIPT(PSBGBL,2)'=$JOB
QUIT
if $QSUBSCRIPT(PSBGBL,1)'["PSBO"
QUIT
Begin DoDot:1
+4 SET DFN=$QSUBSCRIPT(PSBGBL,5)
+5 DO EN1
End DoDot:1
+6 KILL ^TMP("PSBO",$JOB)
+7 QUIT
+8 ;
EN1 ;
+1 SET GMRA="0^0^111"
SET PSBLIST=""
+2 DO EN1^GMRADPT
+3 FOR
SET PSBLIST=$ORDER(GMRAL(PSBLIST))
if 'PSBLIST
QUIT
Begin DoDot:1
+4 KILL PSBARRY
+5 DO EN1^GMRAOR2(PSBLIST,"PSBARRY")
+6 WRITE !,""
+7 WRITE !," Causative agent : "_$PIECE(PSBARRY,U)
+8 ;93
WRITE !," Nature of Reaction : "_$SELECT($PIECE(PSBARRY,U,6)="ALLERGY":"Allergy",$PIECE(PSBARRY,U,6)="PHARMACOLOGIC":"Adverse Reaction",$PIECE(PSBARRY,U,6)="UNKNOWN":"Unknown",1:"")
+9 WRITE !,""
+10 IF $DATA(PSBARRY("S",1))
DO SYMP
+11 IF $DATA(PSBARRY("V",1))
DO CLAS
+12 ;93
WRITE !," Originator : "_$PIECE(PSBARRY,U,2)_$SELECT($LENGTH($PIECE(PSBARRY,U,3)):" ("_$PIECE(PSBARRY,U,3)_")",1:"")
+13 ;93
WRITE !," Originated : "_$PIECE(PSBARRY,U,10)
+14 WRITE !
+15 WRITE !," Verified : "_$SELECT($PIECE(PSBARRY,U,4)="VERIFIED":"Yes",1:"No")
+16 WRITE !," Observed/Historical : "_$SELECT($PIECE(PSBARRY,U,5)="OBSERVED":"Observed",$PIECE(PSBARRY,U,5)="HISTORICAL":"Historical",1:"")
+17 ;W !
+18 ;93
IF $DATA(PSBARRY("O",1))
DO OBS
+19 ;93
IF $DATA(PSBARRY("C",1))
DO COM
+20 WRITE !
+21 WRITE !," ******************************************"
End DoDot:1
+22 QUIT
+23 ;
SYMP ;
+1 SET K=0
SET N=0
FOR
SET K=$ORDER(PSBARRY("S",K))
if K'>0
QUIT
Begin DoDot:1
+2 IF N=0
WRITE !," Signs/symptoms : "_PSBARRY("S",K)
+3 IF '$TEST
WRITE !," "_PSBARRY("S",K)
+4 SET N=N+1
End DoDot:1
+5 WRITE !
+6 KILL N,K
+7 QUIT
CLAS ;
+1 SET K=0
SET N=0
FOR
SET K=$ORDER(PSBARRY("V",K))
if K'>0
QUIT
Begin DoDot:1
+2 IF N=0
WRITE !," Drug Classes : "_$PIECE(PSBARRY("V",K),U,2)
+3 ;MOVED TO THE RIGHT
IF '$TEST
WRITE !," "_$PIECE(PSBARRY("V",K),U,2)
+4 SET N=N+1
End DoDot:1
+5 WRITE !
+6 KILL N,K
+7 QUIT
OBS ;Display originator name ;added tag 93
+1 NEW N,K,Y
+2 SET K=0
SET N=0
FOR
SET K=$ORDER(PSBARRY("O",K))
if K'>0
QUIT
Begin DoDot:1
+3 IF N=0
Begin DoDot:2
+4 SET Y=$PIECE(PSBARRY("O",K),U)
DO DD^%DT
+5 WRITE !," Date/Severity : "_Y_" "_$PIECE(PSBARRY("O",K),U,2)
End DoDot:2
+6 IF '$TEST
Begin DoDot:2
+7 SET Y=$PIECE(PSBARRY("O",K),U)
DO DD^%DT
+8 WRITE !," "_Y_" "_$PIECE(PSBARRY("O",K),U,2)
End DoDot:2
+9 SET N=N+1
End DoDot:1
+10 KILL N,K,Y
+11 QUIT
COM ;display comments - tag added 93
+1 NEW N,K,L,Y
+2 SET K=0
SET N=0
SET Y=0
+3 WRITE !
+4 FOR
SET K=$ORDER(PSBARRY("C",K))
if K'>0
QUIT
Begin DoDot:1
+5 IF N=0
WRITE !," Comments :"
+6 SET Y=$PIECE(PSBARRY("C",K),U)
DO DD^%DT
+7 WRITE " "_Y_" by "_$PIECE(PSBARRY("C",K),U,2)
+8 IF $DATA(PSBARRY("C",K,1,0))
SET L=0
FOR
SET L=$ORDER(PSBARRY("C",K,L))
if L'>0
QUIT
Begin DoDot:2
+9 WRITE !," ",PSBARRY("C",K,L,0)
End DoDot:2
+10 SET N=N+1
End DoDot:1
+11 KILL N,K,L,Y
+12 QUIT
