- 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 Mar 13, 2025@20:44:59 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
