Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBOAL

PSBOAL.m

Go to the documentation of this file.
  1. PSBOAL ;BIRMINGHAM/EFC-BCMA UTILITIES ;Mar 2004
  1. ;;3.0;BAR CODE MED ADMIN;;Mar 2004
  1. ;
  1. ; Reference/IA
  1. ; ^GMRADPT/10099
  1. ; ^GMRAOR2/2422
  1. EN ;
  1. N PSBLIST,PSBGBL,DFN
  1. S PSBGBL="^TMP(""PSBO"",$J,""B"")"
  1. F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'=$J Q:$QS(PSBGBL,1)'["PSBO" D
  1. .S DFN=$QS(PSBGBL,5)
  1. .D EN1
  1. K ^TMP("PSBO",$J)
  1. Q
  1. ;
  1. EN1 ;
  1. S GMRA="0^0^111" S PSBLIST=""
  1. D EN1^GMRADPT
  1. F S PSBLIST=$O(GMRAL(PSBLIST)) Q:'PSBLIST D
  1. .K PSBARRY
  1. .D EN1^GMRAOR2(PSBLIST,"PSBARRY")
  1. .W !,""
  1. .W !," Causative agent : "_$P(PSBARRY,U)
  1. .W !,""
  1. .I $D(PSBARRY("S",1)) D SYMP
  1. .I $D(PSBARRY("V",1)) D CLAS
  1. .W !," Verified : "_$S($P(PSBARRY,U,4)="VERIFIED":"Yes",1:"No")
  1. .W !," Observed/Historical : "_$S($P(PSBARRY,U,5)="OBSERVED":"Observed",$P(PSBARRY,U,5)="HISTORICAL":"Historical",1:"")
  1. .W !," ******************************************"
  1. Q
  1. ;
  1. SYMP ;
  1. S K=0,N=0 F S K=$O(PSBARRY("S",K)) Q:K'>0 D
  1. .I N=0 W !," Signs/symptoms : "_PSBARRY("S",K)
  1. .E W !," "_PSBARRY("S",K)
  1. .S N=N+1
  1. W !
  1. K N,K
  1. Q
  1. CLAS ;
  1. S K=0,N=0 F S K=$O(PSBARRY("V",K)) Q:K'>0 D
  1. .I N=0 W !," Drug Classes : "_$P(PSBARRY("V",K),U,2)
  1. .E W !," "_$P(PSBARRY("V",K),U,2)
  1. .S N=N+1
  1. W !
  1. K N,K
  1. Q