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

PSBODO.m

Go to the documentation of this file. 
  1. PSBODO ;BIRMINGHAM/EFC - BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;Dec 22, 2021@07:55:46
  1.  ;;3.0;BAR CODE MED ADMIN;**5,21,24,38,58,68,70,83,98,106,93**;Mar 2004;Build 111
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference/IA
  1.  ; EN^PSJBCMA2/2830
  1.  ; GETPROVL^PSGSICH1/5653
  1.  ; INTRDIC^PSGSICH1/5654
  1.  ; GETSIOPI^PSJBCMA5/5763
  1.  ; VA(200)/10060 - NEW PERSON FILE
  1.  ;
  1.  ;*68 - add ability to print new WP Special Instructions/OPI fields
  1.  ;*58 - add sections to display Prv Override comments and Rph
  1.  ;      Interventions to this report for (critical drug/drug and all
  1.  ;      adverse reactions/allergies)
  1.  ;*70 - print clinic name at top of detail section if exists.
  1.  ;*83 - add Removal times
  1.  ;*106- add Hazardous Handle & Dispose flags ;
  1.  ;*93 - add order check to Display Order form, add Indication to order detail
  1.  ;
  1. EN ;
  1.  ;
  1.  ; Description:
  1.  ; Returns a display for a selected order when double clicked on the VDL
  1.  ;
  1.  N PSBGBL,DFN
  1.  S PSBGBL=$NAME(^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 DISPORD
  1.  .D CLEAN^PSBVT   ;*83 cleanup all PSB* variables
  1.  Q
  1.  ;
  1. DISPORD ;
  1.  N PSBGBL,PSBOI,PSBHDR,PSJGLO,LINE,PSBPRV,PSBPV,PSBRPH,PSBRH,PSBOVR,I,X,Y
  1.  N CNT,DIWF,DIWL,DIWR
  1.  S PSBOI=$$GET1^DIQ(53.69,PSBRPT_",",.09)
  1.  D EN^PSJBCMA2(DFN,PSBOI)
  1.  S PSJGLO="^TMP(""PSJ"""_","_$J
  1.  D CLEAN^PSBVT
  1.  D PSJ1^PSBVT(DFN,PSBOI)
  1.  S PSBHDR(1)="BCMA - Display Order" D PT^PSBOHDR(DFN,.PSBHDR) W !
  1.  I '$G(PSBONX) W !,"Invalid Order"
  1.  D:$G(PSBONX)
  1.  .W:$G(PSBCLORD)]"" "Clinic: "_PSBCLORD,!                         ;*70
  1.  .W !,"Orderable Item: ",PSBOITX
  1.  .W !?17,$S(PSBHAZHN:"<<HAZ Handle>> ",1:""),$S(PSBHAZDS:"<<HAZ Dispose>>",1:"")    ;*106
  1.  .I PSBONX["V" W !,"Infusion Rate:  ",PSBIFR
  1.  .I PSBONX'["V" W !,"Dosage Ordered: ",PSBDOSE
  1.  .W ?40,"Start:    ",PSBOSTX W:$G(^XTMP("PSB DEBUG",0)) "   ("_PSBONX_")"
  1.  .W !?40,"Stop:     ",PSBOSPX,?70,PSBOSTSX                        ;*70
  1.  .W !,"Med Route:      ",PSBMR
  1.  .W !,"Schedule Type:  ",PSBSCHTX
  1.  .I PSBONX'["V" W ?40,"Self Med: ",PSBSMX
  1.  .W:PSBSM !?40,"Hosp Sup: ",PSBSMX
  1.  .W:PSBSCH'="" !,"Schedule: ",PSBSCH
  1.  .I PSBONX'["V" W !,"Admin Times:    ",PSBADST
  1.  .I PSBONX'["V",PSBMRRFL W !,"Removal Times:  ",$$REMSTR^PSBUTL(PSBADST,PSBDOA,PSBSCHT,PSBOSP,PSBOPRSP)
  1.  .I PSBONX["V",((PSBIVT="P")!(PSBISYR=1)) W !,"Admin Times:    ",PSBADST
  1.  .W !,"Provider: ",PSBMDX
  1.  .;*68 change
  1.  .W !,"Special Instructions/Other Print Info:"
  1.  .K ^TMP("PSJBCMA5",$J)
  1.  .D GETSIOPI^PSJBCMA5(DFN,PSBONX,1)
  1.  .F QQ=0:0 S QQ=$O(^TMP("PSJBCMA5",$J,DFN,PSBONX,QQ)) Q:'QQ  D
  1.  ..W !,^TMP("PSJBCMA5",$J,DFN,PSBONX,QQ)
  1.  .K ^TMP("PSJBCMA5",$J)
  1.  .W !,"Indication: "_$P($G(^PS(55,+$G(DFN),$S(PSBONX["V":"IV",1:5),+PSBONX,18)),U)
  1.  .;*68 end
  1.  .;*58 override/intervention section * * *
  1.  .S PSBOVR=0
  1.  .D GETPROVL^PSGSICH1(DFN,PSBONX,.PSBPRV)
  1.  .D INTRDIC^PSGSICH1(DFN,PSBONX,.PSBRPH,2)
  1.  .S PSBPV=$S($D(PSBPRV)>1:1,1:0)
  1.  .S PSBRH=$S($D(PSBRPH)>1:1,1:0)
  1.  .I 'PSBPV,PSBRH D DSPPRV(.PSBPRV,132,2,26,1) S PSBOVR=1
  1.  .I PSBPV D DSPPRV(.PSBPRV,132,2,26) S PSBOVR=1
  1.  .I PSBPV,'PSBRH D DSPRPH(.PSBRPH,132,2,26,1) S PSBOVR=1
  1.  .I PSBRH D DSPRPH(.PSBRPH,132,2,26) S PSBOVR=1
  1.  .I PSBOVR W !,$TR($J("",75)," ","-")
  1.  .;*58 end override/intervention section * * *
  1.  .;
  1.  .W !
  1.  .I $D(PSBDDA(1)) D
  1.  ..W !,"Dispense Drugs",!,"Drug Name",?40,"Units",?50,"Inactive Date"
  1.  ..W !,$TR($J("",75)," ","-")
  1.  ..F Y=0:0 S Y=$O(PSBDDA(Y)) Q:'Y  D
  1.  ...S X=$P(PSBDDA(Y),U,4)
  1.  ...W !,$P(PSBDDA(Y),U,3),?40,$S(X]"":X,1:1)
  1.  ...S X=$P(PSBDDA(Y),U,5) Q:'X
  1.  ...W ?50,$E(X,4,5),"/",$E(X,6,7),"/",(1700+$E(X,1,3))
  1.  .I $D(PSBADA(1)) D
  1.  ..W !!,"Additives",!,"Name",?40,"Strength"
  1.  ..W !,$TR($J("",75)," ","-")
  1.  ..F Y=0:0 S Y=$O(PSBADA(Y)) Q:'Y  D
  1.  ...W !,$P(PSBADA(Y),U,3),?40,$P(PSBADA(Y),U,4)
  1.  .I $D(PSBSOLA(1)) D
  1.  ..W !!,"Solution",!,"Name",?40,"Volume"
  1.  ..W !,$TR($J("",75)," ","-")
  1.  ..F Y=0:0 S Y=$O(PSBSOLA(Y)) Q:'Y  D
  1.  ...W !,$P(PSBSOLA(Y),U,3),?40,$P(PSBSOLA(Y),U,4)
  1.  .I $P(@(PSJGLO_","_0_")"),U,1)'=-1 D
  1.  ..W !,$TR($J("",75)," ","-")
  1.  ..W !,"Pharmacy Activity Log: "
  1.  ..F I=1:1:$P(@(PSJGLO_","_0_")"),U,4) D
  1.  ...W !?9,"Date:  ",$$FMTE^XLFDT($P(@(PSJGLO_","_I_","_1_")"),U,1)),?35,"User:  ",$P(@(PSJGLO_","_I_","_1_")"),U,2)
  1.  ...W !?5,"Activity:  ",$P(@(PSJGLO_","_I_","_1_")"),U,4)
  1.  ...I $D(@(PSJGLO_","_I_","_2_")")) D                             ;*83
  1.  ....I $P(@(PSJGLO_","_I_","_1_")"),U,3)["DURATION" S @(PSJGLO_","_I_","_2_")")=@(PSJGLO_","_I_","_2_")")/60     ;DOA convert min to hr *83
  1.  ....W !?8,"Field:  ",$P(@(PSJGLO_","_I_","_1_")"),U,3),!?5,"Old Data:  ",$S($P(@(PSJGLO_","_I_","_1_")"),U,3)["DATE":$$FMTE^XLFDT(@(PSJGLO_","_I_","_2_")")),1:@(PSJGLO_","_I_","_2_")")) ;correct date, PSB*3*98
  1.  ...I $D(@(PSJGLO_","_I_","_3_")")) W !?7,"Reason:  ",@(PSJGLO_","_I_","_3_")")
  1.  ...W !
  1.  .;*93 begin
  1.  .S CNT=0
  1.  .N ORCPRS,ORIFN,LST,ORY  ;remove LST
  1.  .K ^TMP("PSBORTXT",$J)
  1.  .S ORCPRS=0
  1.  .I PSBONX["U" D PSS431^PSS55(DFN,+PSBONX,,,"PSB") S ORCPRS=$G(^TMP($J,"PSB",+PSBONX,66))
  1.  .I PSBONX["V" D PSS436^PSS55(DFN,+PSBONX,"PBS") S ORCPRS=$G(^TMP($J,"PBS",+PSBONX,110))
  1.  .S ORIFN=ORCPRS,ORY=$NA(^TMP("PSBORTXT",$J)),@ORY=""
  1.  .D ORCHECK  ;create the CPRS order check
  1.  .K ^TMP("PSBORTXT",$J)
  1.  .;*93 end
  1.  W !!
  1.  D CLEAN^PSBVT K @(PSJGLO_")")
  1.  Q
  1.  ;
  1. DSPPRV(ARR,LN,IND,ALGN,NONE) ; Display Provider (CPRS) override reasons
  1.  ; ARR  = array with provider override text.
  1.  ; LN   = total width of report writable area.      (opt, 132 default)
  1.  ; IND  = indent for both left and right margins.      (opt,0 default)
  1.  ; ALGN = align colon on this column.                (opt, 25 default)
  1.  ; NONE = display empty Provider override msg.        (opt, 0 default)
  1.  ;
  1.  N CAT,QQ,OC,HDG,CTRTAB,TMPONX,LINE,L1,L2,XX
  1.  S LN=+$G(LN,132),IND=+$G(IND),ALGN=$G(ALGN,25),NONE=$G(NONE,0)
  1.  S LN=LN-(IND*2)    ;adj writeable area by both L & R margins
  1.  ;provider heading
  1.  W !!?IND,$TR($J("",LN)," ","=")
  1.  S HDG="** Current Provider Overrides for this order **"
  1.  S CTRTAB=(LN-$L(HDG))/2
  1.  W !?CTRTAB,HDG
  1.  W !?IND,$TR($J("",LN)," ","="),!
  1.  ;
  1.  ;special scenario when NO Prv overrides, but Rph Interventions do
  1.  I NONE W !?IND,"No Provider Overrides to display.",! Q
  1.  ;
  1.  ;provider body text
  1.  S TMPONX=$O(ARR("PROV",DFN,"")) I TMPONX D
  1.  .S QQ="" F  S QQ=$O(ARR("PROV",DFN,+TMPONX,QQ)) Q:QQ=""  D
  1.  ..S LINE=ARR("PROV",DFN,+TMPONX,QQ),XX=$F(LINE,":")
  1.  ..S L1=$J($E(LINE,1,XX),ALGN),L2=$E(LINE,XX+1,$L(LINE))
  1.  ..W !?IND,L1,L2
  1.  .W !
  1.  S CAT=0 F  S CAT=$O(ARR("PROVR",DFN,+TMPONX,CAT)) Q:'CAT  D
  1.  .S OC=0 F  S OC=$O(ARR("PROVR",DFN,+TMPONX,CAT,OC)) Q:'OC  D
  1.  ..S LINE=ARR("PROVR",DFN,+TMPONX,CAT,OC,0),XX=$F(LINE,":")
  1.  ..S L1=$J($E(LINE,1,XX),ALGN),L2=$E(LINE,XX+1,$L(LINE))
  1.  ..W !,?IND,$$WRAP^PSBO(IND,LN,LINE),!
  1.  Q
  1.  ;
  1. DSPRPH(ARR,LN,IND,ALGN,NONE) ; Display Pharmacist Interventions
  1.  ; ARR  = array with Pharmacist intervention text.               (opt)
  1.  ; LN   = total width of report writable area.       (opt,132 default)
  1.  ; IND  = indent for both left and right margins.     (opt, 0 default)
  1.  ; ALGN = align colon on this column.                (opt. 25 default)
  1.  ; NONE = display empty Pharmacist intervention msg.  (opt, 0 default)
  1.  ;
  1.  N FLD,WP,WPTAG,WPLIN,HDG,INT,CTRTAB,LINE,L1,L2,XX
  1.  S LN=+$G(LN,132),IND=+$G(IND),ALGN=$G(ALGN,25),NONE=$G(NONE,0)
  1.  S LN=LN-(IND*2)         ;adj writeable area by both L & R margins
  1.  ;
  1.  ;pharmacist heading
  1.  W !?IND,$TR($J("",LN)," ","=")
  1.  S HDG="** Current Pharmacist Interventions for this order **"
  1.  S CTRTAB=(LN-$L(HDG))/2
  1.  W !?CTRTAB,HDG
  1.  W !?IND,$TR($J("",LN)," ","="),!
  1.  ;
  1.  ;special scenario when NO Rph interventions, but Prv overrides do
  1.  I NONE W !?IND,"No Pharmacist Interventions to display.",! Q
  1.  ;
  1.  ;pharmacist body text
  1.  F INT=0:0 S INT=$O(ARR(DFN,PSBONX,INT)) Q:'INT  D
  1.  .F FLD=0:0 S FLD=$O(ARR(DFN,PSBONX,INT,FLD)) Q:'FLD  D
  1.  ..I FLD<1000 D
  1.  ...S LINE=ARR(DFN,PSBONX,INT,FLD),XX=$F(LINE,":")
  1.  ...S L1=$J($E(LINE,1,XX),ALGN),L2=$E(LINE,XX+1,$L(LINE))
  1.  ...W !?IND,L1,L2
  1.  ..I FLD>1000 D
  1.  ...S (WP,WPLIN,WPTAG)="",LIN1=1
  1.  ...F  S WP=$O(ARR(DFN,PSBONX,INT,FLD,WP)) Q:WP=""  D
  1.  ....S LINE=ARR(DFN,PSBONX,INT,FLD,WP)
  1.  ....I WP<1 D                          ;field Hdg line
  1.  .....S LINE=$J(LINE,ALGN) W !?IND,LINE
  1.  ....E  D                              ;detail WP lines
  1.  .....I 'LIN1 W !
  1.  .....W ?IND+ALGN,LINE
  1.  .....S LIN1=0
  1.  .W !
  1.  W !
  1.  Q
  1. DSPORCK(LN,IND,ALGN,NONE) ; Display Order Check(CPRS) #93 NEW TAG
  1.  ; LN   = total width of report writable area.      (opt, 132 default)
  1.  ; IND  = indent for both left and right margins.      (opt,0 default)
  1.  ; ALGN = align colon on this column.                (opt, 25 default)
  1.  ; NONE = display empty order check msg.        (opt, 0 default)
  1.  ;
  1.  N CAT,QQ,OC,HDG,CTRTAB
  1.  S LN=+$G(LN,132),IND=+$G(IND),ALGN=$G(ALGN,25),NONE=$G(NONE,0)
  1.  S LN=LN-(IND*2)    ;adj writeable area by both L & R margins
  1.  ;order check heading
  1.  W !!?IND,$TR($J("",LN)," ","=")
  1.  S HDG="** Current Order Check **"
  1.  S CTRTAB=(LN-$L(HDG))/2
  1.  W !?CTRTAB,HDG
  1.  W !?IND,$TR($J("",LN)," ","="),!
  1.  ;
  1.  ; if there isn't order check information to display
  1.  I NONE W !?IND,"No Order Check to display.",! Q
  1.  ;
  1.  ;write out order check text
  1.  S QQ=0 F  S QQ=$O(^TMP("PSBORTXT",$J,QQ)) Q:QQ'>0  W ?IND,$G(^TMP("PSBORTXT",$J,QQ)),!
  1.  Q
  1. ORCHECK ; recreate CPRS Order Check - copied from ORQ2 #93
  1.  K ^TMP($J,"PSBOCDATA")
  1.  I '$$OCAPI^ORCHECK(+ORIFN,"PSBOCDATA") D DSPORCK(132,2,26,1) Q
  1.  E  D
  1.  . N CK,OK,X0,X,CDL,I,ACK,ALLGYDRG,HDR S HDR=0
  1.  . S ACK=0
  1.  . D ALLERGY
  1.  . S:$D(OK) OK=""
  1.  . S CK=0 F  S CK=$O(^TMP($J,"PSBOCDATA",CK)) Q:CK'>0  D
  1.  .. Q:$D(ALLGYDRG(CK))  ;skip allergy entries
  1.  .. S:HDR=0 CNT=CNT+1,@ORY@(CNT)=" ",CNT=CNT+1,@ORY@(CNT)="Order Checks:",CNT=CNT+1,@ORY@(CNT)=" ",HDR=1
  1.  .. S X0=^TMP($J,"PSBOCDATA",CK,"OC NUMBER")_U_^TMP($J,"PSBOCDATA",CK,"OC LEVEL")_U_U_^TMP($J,"PSBOCDATA",CK,"OR REASON")_U_^TMP($J,"PSBOCDATA",CK,"OR PROVIDER")_U_^TMP($J,"PSBOCDATA",CK,"OR DT")
  1.  .. S X=^TMP($J,"PSBOCDATA",CK,"OC TEXT",1,0)
  1.  .. S CDL=$$CDL($P(X0,U,2)) I $P(X0,U,6),'$D(OK) S OK=$P(X0,U,4,6)
  1.  .. I $L(X)'>100 S CNT=CNT+1,@ORY@(CNT)=CDL_X D XTRA Q
  1.  .. S DIWL=1,DIWR=100,DIWF="C100" K ^UTILITY($J,"W") D ^DIWP
  1.  .. S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=CDL_^(I,0),CDL="            "
  1.  .. D XTRA
  1.  . K ^TMP($J,"PSBOCDATA")
  1.  . Q:(HDR=0)
  1.  . Q:'$L($G(OK))  S CNT=CNT+1,@ORY@(CNT)="Override:   "_$S($P(OK,U,2):$$USER($P(OK,U,2))_" on ",1:"")_$TR($$FMTE^XLFDT($P(OK,U,3),"6MZ"),"@"," ")
  1.  . I $L($P(OK,U))'>100 S CNT=CNT+1,@ORY@(CNT)="            "_$P(OK,U) Q
  1.  . S DIWL=1,DIWR=100,DIWF="C100",X=$P(OK,U) K ^UTILITY($J,"W") D ^DIWP
  1.  . S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)="            "_^(I,0)
  1.  D DSPORCK(132,2,26) ;print order check
  1.  K ^UTILITY($J,"W"),ALLGYDRG
  1.  Q
  1.  ;
  1. ALLERGY  ;separate the ALLERGY-DRUG INTERACTION Order Checks  #93 NEW TAG
  1.  N RET,INSTANCE,INSTASAV
  1.  S RET=1,(ACK,CK,CNT)=0
  1.  F  S CK=$O(^TMP($J,"PSBOCDATA",CK)) Q:CK'>0  D
  1.  . I $G(^TMP($J,"PSBOCDATA",CK,"OC NUMBER"))'=3 Q  ;only select the allergy-drug interactions
  1.  . S ALLGYDRG(CK)=" "
  1.  . I ACK=0 S CNT=CNT+1,@ORY@(CNT)=" ",CNT=CNT+1,@ORY@(CNT)="Allergy Order Checks:",CNT=CNT+1,ACK=1
  1.  . S X0=^TMP($J,"PSBOCDATA",CK,"OC NUMBER")_U_^TMP($J,"PSBOCDATA",CK,"OC LEVEL")_U_U_^TMP($J,"PSBOCDATA",CK,"OR REASON")_U_^TMP($J,"PSBOCDATA",CK,"OR PROVIDER")_U_^TMP($J,"PSBOCDATA",CK,"OR DT")
  1.  . S X=^TMP($J,"PSBOCDATA",CK,"OC TEXT",1,0)
  1.  . S CDL=$$CDL($P(X0,U,2)) I $P(X0,U,6),'$D(OK) S OK=$P(X0,U,4,6)
  1.  . I $L(X)'>100 S CNT=CNT+1,@ORY@(CNT)=CDL_X D XTRA Q
  1.  . S DIWL=1,DIWR=100,DIWF="C100" K ^UTILITY($J,"W") D ^DIWP
  1.  . S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=CDL_^(I,0),CDL="            "
  1.  . S INSTANCE=$G(^TMP($J,"PSBOCDATA",CK,"OC INSTANCE"))
  1.  . I INSTANCE>0  D
  1.  .. I $$GET1^DIQ(100.517,RET_","_INSTANCE_",",11)'=""  D
  1.  ... S:'$D(INSTASAV) INSTASAV=INSTANCE
  1.  . D XTRA
  1.  I ACK=1  D  ;if there are allergy-drug interaction check for override
  1.  . Q:'$L($G(OK))  S CNT=CNT+1,@ORY@(CNT)="Override:   "_$S($P(OK,U,2):$$USER($P(OK,U,2))_" on ",1:"")_$TR($$FMTE^XLFDT($P(OK,U,3),"6MZ"),"@"," ")
  1.  . I $L($P(OK,U))'>100 S CNT=CNT+1,@ORY@(CNT)="            "_$P(OK,U),CNT=CNT+1 Q
  1.  . S DIWL=1,DIWR=100,DIWF="C100",X=$P(OK,U) K ^UTILITY($J,"W") D ^DIWP
  1.  . S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)="            "_^(I,0)
  1.  I $D(INSTASAV)  D
  1.  . S CNT=CNT+1,@ORY@(CNT)="            "
  1.  . S CNT=CNT+1,@ORY@(CNT)="Remote Comment: "_$$GET1^DIQ(100.517,RET_","_INSTASAV_",",11)
  1.  Q
  1. CDL(X) ; -- Returns Clinical Danger Level X    #93 NEW TAG
  1.  N Y S Y=$S(X=1:"HIGH:",X=2:"MODERATE:",X=3:"LOW:",1:"NONE:")
  1.  S Y=$E(Y_"        ",1,12)
  1.  Q Y
  1.  ;
  1. XTRA ;  #93 NEW TAG
  1.  I $O(^TMP($J,"PSBOCDATA",CK,"OC TEXT",1)) N ORXT S ORXT=1 F  S ORXT=$O(^TMP($J,"PSBOCDATA",CK,"OC TEXT",ORXT)) Q:'ORXT  D
  1.  . S X=^TMP($J,"PSBOCDATA",CK,"OC TEXT",ORXT,0),CDL="              "
  1.  . I $L(X)'>100 S CNT=CNT+1,@ORY@(CNT)=CDL_X Q
  1.  . S DIWL=1,DIWR=100,DIWF="C100" K ^UTILITY($J,"W") D ^DIWP
  1.  . S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=CDL_^(I,0),CDL="              "
  1.  I $O(^TMP($J,"PSBOCDATA",CK,"OC TEXT",1)) S X="",CNT=CNT+1,@ORY@(CNT)="              "
  1.  Q
  1.  ;
  1. USER(X)  ; -- Returns NAME (TITLE) of New Person X   #93 NEW TAG
  1.  N Y,Z
  1.  S Y=$$GET1^DIQ(200,+X,.01),Z=$$GET1^DIQ(200,+X,8)
  1.  S:(Z'="") Y=Y_" ("_Z_")"   ;check if title exist
  1.  Q Y