- PSJUTL3 ;BIR/MLM-MISC. INPATIENT UTILITIES ;29 OCT 01 / 4:29 PM
- ;;5.0;INPATIENT MEDICATIONS;**58,353,426*;16 DEC 97;Build 4
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Reference to ^PSSLOCK is supported by DBIA# 2789.
- ;
- EN ;
- Q:$$PATCH^XPDUTL("PSJ*5.0*58")
- S ZTDTH=$H,ZTRTN="QUEIV^PSJUTL3",ZTIO="",ZTDESC="Inpatient medications - Mark IV orders as verified"
- D ^%ZTLOAD
- Q
- QUEIV ;
- D XTMP
- NEW DFN,START,PSJX
- D NOW^%DTC S START=%
- F DFN=0:0 S DFN=$O(^PS(55,DFN)) Q:'DFN D
- . S PSJX=$P($G(^PS(55,DFN,5.1)),U,11)
- . Q:PSJX=3
- . I PSJX=2 D MARKIV(DFN) Q
- . D CNIV^PSJUTL1(DFN)
- D SEND(START)
- Q
- XTMP ;
- I '$D(^XTMP("PSJ NEW PERSON",0)) D
- . NEW X1,X2 S X1=DT,X2=30 D C^%DTC
- . S ^XTMP("PSJ NEW PERSON",0)=X_U_DT_U_"Correct changed user names"
- Q
- ;
- MARKIV(DFN) ;
- ;Mark the Verifying Pharmacy field for active order created prior
- ; to PSJ*5*58
- NEW ON,ON55,X,PSJPINIT,PSJIDT,PSJNOW,PSIVACT
- Q:'$$L^PSSLOCK(DFN,0)
- D NOW^%DTC S PSJNOW=$E(%,1,12)
- S PSJIDT=$$INSTLDT^PSJUTL1() I PSJIDT="" S PSJIDT=PSJNOW
- S $P(^PS(55,DFN,5.1),U,11)=3
- F ON=0:0 S ON=$O(^PS(55,DFN,"IV",ON)) Q:'ON D
- . S X=$G(^PS(55,DFN,"IV",ON,2))
- . I +X>PSJIDT Q
- . S PSJPINIT=$P(X,U,11)
- . NEW XX,XX1,PSJIEN
- . F XX=0:0 S XX=$O(^PS(55,DFN,"IV",ON,"A",XX)) Q:'XX D
- .. NEW PSJX S XX1=$G(^PS(55,DFN,"IV",ON,"A",XX,0))
- .. Q:$P(XX1,U,3)=""
- .. K PSJIEN S PSJX=""
- .. I $P(XX1,U,6)="" D
- ... D NAME^PSJBCMA1($P(XX1,U,3),,,.PSJIEN)
- ... S:PSJIEN>0 $P(^PS(55,DFN,"IV",ON,"A",XX,0),U,6)=PSJIEN,XX1=^(0)
- .. Q:+$P($G(^PS(55,DFN,"IV",ON,4)),U,4)
- .. I $P(XX1,U,2)="F",($P(XX1,U,4)'="FINISHED BY TECHNICIAN") S PSJPINIT=$P(XX1,U,6),PSJX=1
- .. S:$G(PSJIEN)=-1 ^XTMP("PSJ NEW PERSON",1,$P(XX1,U,3),DFN,ON,XX)=PSJX
- . Q:+PSJPINIT'>0
- . Q:+$P($G(^PS(55,DFN,"IV",ON,4)),U,4)
- . D VF(ON,DFN,PSJPINIT,PSJNOW)
- D UL^PSSLOCK(DFN)
- Q
- VF(ON,DFN,PSJPINIT,PSJNOW) ; Update verifying pharm and date fields.
- K DA,DIE,DR
- S PSIVACT=""
- S DIE="^PS(55,"_DFN_",""IV"",",DA=ON,DA(1)=DFN
- S DR="140////"_PSJPINIT_";141////"_PSJNOW_";142////1" D ^DIE
- S ON55=ON,PSIVREA="V",PSIVALT=""
- S PSIVAL="AUTO VERIFIED WITH PATCH PSJ*5*58"
- D LOG^PSIVORAL K PSIVAL,PSIVALT,PSIVREA
- Q
- SEND(START) ;
- NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,STOP,LINE
- D NOW^%DTC S STOP=%
- S LINE(1)="Marking prior IV orders as verified started: "_$$FMTE^XLFDT(START)
- S LINE(2)="It ran to completion: "_$$FMTE^XLFDT(STOP)
- I $O(^XTMP("PSJ NEW PERSON",0)) D
- . S LINE(3)=""
- . S LINE(4)="Please assign the PSJI ACTIVITY LOG VA200 option to a holder of the"
- . S LINE(5)="PSJI MGR key who is familiar with the Pharmacy users to correct any "
- . S LINE(6)="names that the software was unable to match to the New Person file (#200)."
- S XMSUB="PSJ*5*58 IV Verification",XMTEXT="LINE("
- S XMDUZ="PSJ*5*58"
- S XMY(+DUZ)="" D ^XMD
- Q
- ;
- DMACTN ;Entry point for DM hidden action from backdoor LM OE *353
- N GL,IFN,NXT,NODD,NXTROOT,ROOT,QQ
- D FULL^VALM1
- W #
- S (IFN,NXT,NODD)=0
- I ((NAME["PSJ LM UD")!(NAME["PSJU LM")),$G(PSGDRG) S IFN=+PSGDRG D SHOWDR ;Unit Dose backdoor New order entry in process Drug ien, but is OI ien when New IV's
- ;all other Unit dose input
- I ((NAME["PSJ LM UD")!(NAME["PSJU LM")!(NAME["PSJ LM PENDING")),'$G(PSGDRG) D ;Unit Dose DD mult
- . I $G(PSGORD)["P" S PSGOEEWF="^PS(53.1,"_+PSGORD_","
- . I '$G(PSGORD),ON["P" S PSGOEEWF="^PS(53.1,"_+ON_","
- . F QQ=0:0 S ROOT=PSGOEEWF_"1,"_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
- .. S NODD=NODD+1,NXTROOT=PSGOEEWF_"1,"_QQ_")",NXT=$O(@NXTROOT),GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)")
- .. D SHOWDR
- ;all IV's
- I NAME["PSJ LM IV" D
- . S:ON["P" PSGOEEWF="^PS(53.1,"_+ON_","
- . S:ON["V" PSGOEEWF="^PS(55,"_DFN_",""IV"","_+ON_"," ;IV, Chk IV Additives
- . F QQ=0:0 S ROOT=PSGOEEWF_"""AD"","_QQ_")" S QQ=$O(@ROOT) Q:'QQ D
- .. S NODD=NODD+1,NXTROOT=PSGOEEWF_"""AD"","_QQ_")",NXT=$O(@NXTROOT),GL=$E(NXTROOT,1,$L(ROOT)-1),IFN=+@(GL_",0)") S:IFN IFN=+$P($G(^PS(52.6,IFN,0)),U,2)
- .. D SHOWDR
- I '$G(PSGDRG),'NODD D SHOWDR ;err, No IFN, No DD, & No IV Ads, display msg
- D PICKDR
- S VALMBCK="R"
- Q
- ;
- PICKDR ;Entry point for Selecting a diff Drug
- N IFN,Y
- W ! K DIC S DIC="^PSDRUG(",DIC(0)="AEQMVTN",DIC("T")="" W "Return to continue or" D ^DIC K DIC I Y<0 Q
- S IFN=+Y
- D SHOWDR
- G PICKDR
- ;
- SHOWDR ;Entry point to Display Drug hidden action info (via defaulted IFN)
- N DIR,OIPTR
- I 'IFN W !!,"** NO Dispense Drug entered for this order",! G PICKDR
- I NODD=1,NXT W "** MULTIPLE DISP DRUGS **"
- W !,"DRUG NAME: ",$$GET1^DIQ(50,IFN_",","GENERIC NAME")," (IEN: "_IFN_")"
- S OIPTR=^PSDRUG(IFN,2) S:$P(OIPTR,"^",1)]"" OIPTR=$P(OIPTR,"^",1)
- I OIPTR]"" W !," ORDERABLE ITEM TEXT: ",! D DMOITXT
- W !," MESSAGE: ",$$GET1^DIQ(50,IFN_",","MESSAGE") D FULL
- W !," QTY DISP MESSAGE: ",$$GET1^DIQ(50,IFN_",","QUANTITY DISPENSE MESSAGE"),! D FULL
- K Y
- Q
- ;
- DMOITXT ;Get Pharmacy Orderable Item drug text fields
- N DDD,QUIT,TEXT,TEXTPTR,TXT
- I $D(^PS(50.7,OIPTR,1,0)) F TXT=0:0 S TXT=$O(^PS(50.7,OIPTR,1,TXT)) Q:'TXT D
- . S TEXTPTR=^PS(50.7,OIPTR,1,TXT,0)
- . F DDD=0:0 S DDD=$O(^PS(51.7,TEXTPTR,2,DDD)) Q:'DDD I '$$INACDATE S TEXT=^PS(51.7,TEXTPTR,2,DDD,0) D FULL Q:$G(QUIT) W " ",TEXT,!
- Q
- ;
- FULL ;Screen is full, pause
- D:($Y+3)>IOSL&('$G(QUIT)) FSCRN
- Q
- ;
- FSCRN ;User Wait as screen if full
- Q:$G(QUIT) K DIR S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR W @IOF S:Y'=1 QUIT=1
- Q
- ;
- INACDATE() ;Check Inactive date
- Q $P($G(^PS(51.7,TEXTPTR,0)),"^",2)
- ;
- VPACTN ;Entry point for VP hidden action from PSJ OE-testing bg *353
- D FULL^VALM1
- N IFN S IFN=+$G(P("6")) I 'IFN S IFN=+$G(PSGPR)
- D SHOWVP
- S VALMBCK="R"
- Q
- ;
- PICKVP ;Entry Point For Selecting a diff provider
- N IFN,Y
- W ! K DIC S DIC="^VA(200,",DIC(0)="AEQMVTN",DIC("T")="" W !,"Return to continue or" D ^DIC K DIC I Y<0 Q
- S IFN=+Y
- ;
- SHOWVP ;Entry point to Display Provider hidden action info (via defaulted IFN)
- N DIR
- I 'IFN W !,"No provider entered for this order",! G PICKVP
- W #,"PROVIDER TITLE: ",$$GET1^DIQ(200,IFN_",","TITLE")
- W !!,"PROVIDER REMARKS: ",$$GET1^DIQ(200,IFN_",","REMARKS")
- W !!,"PROVIDER SPECIALTY: ",$$GET1^DIQ(200,IFN_",","PROVIDER CLASS"),!," "_$$GET1^DIQ(200,IFN_",","SERVICE/SECTION")
- K Y
- G PICKVP
- Q
- ;
- DELNV(DFN,ORDER) ; Deletes/Resets Nurse Verification in PHARMACY PATIENT file (#55), used by BCMA
- ;Input: DFN - Pointer the PATIENT file (#2)
- ; ORDER - Pointer to ORDER sub-file in file #55 (e.g., "124U", "321V")
- I $P($G(^PS(55,+$G(DFN),$S(ORDER["V":"IV",1:5),+$G(ORDER),4)),"^",10) D
- . S $P(^PS(55,DFN,$S(ORDER["V":"IV",1:5),+ORDER,4),"^",1)=""
- . S $P(^PS(55,DFN,$S(ORDER["V":"IV",1:5),+ORDER,4),"^",2)=""
- . S $P(^PS(55,DFN,$S(ORDER["V":"IV",1:5),+ORDER,4),"^",10)=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJUTL3 6862 printed Feb 18, 2025@23:35:36 Page 2
- PSJUTL3 ;BIR/MLM-MISC. INPATIENT UTILITIES ;29 OCT 01 / 4:29 PM
- +1 ;;5.0;INPATIENT MEDICATIONS;**58,353,426*;16 DEC 97;Build 4
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +4 ; Reference to ^PSSLOCK is supported by DBIA# 2789.
- +5 ;
- EN ;
- +1 if $$PATCH^XPDUTL("PSJ*5.0*58")
- QUIT
- +2 SET ZTDTH=$HOROLOG
- SET ZTRTN="QUEIV^PSJUTL3"
- SET ZTIO=""
- SET ZTDESC="Inpatient medications - Mark IV orders as verified"
- +3 DO ^%ZTLOAD
- +4 QUIT
- QUEIV ;
- +1 DO XTMP
- +2 NEW DFN,START,PSJX
- +3 DO NOW^%DTC
- SET START=%
- +4 FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,DFN))
- if 'DFN
- QUIT
- Begin DoDot:1
- +5 SET PSJX=$PIECE($GET(^PS(55,DFN,5.1)),U,11)
- +6 if PSJX=3
- QUIT
- +7 IF PSJX=2
- DO MARKIV(DFN)
- QUIT
- +8 DO CNIV^PSJUTL1(DFN)
- End DoDot:1
- +9 DO SEND(START)
- +10 QUIT
- XTMP ;
- +1 IF '$DATA(^XTMP("PSJ NEW PERSON",0))
- Begin DoDot:1
- +2 NEW X1,X2
- SET X1=DT
- SET X2=30
- DO C^%DTC
- +3 SET ^XTMP("PSJ NEW PERSON",0)=X_U_DT_U_"Correct changed user names"
- End DoDot:1
- +4 QUIT
- +5 ;
- MARKIV(DFN) ;
- +1 ;Mark the Verifying Pharmacy field for active order created prior
- +2 ; to PSJ*5*58
- +3 NEW ON,ON55,X,PSJPINIT,PSJIDT,PSJNOW,PSIVACT
- +4 if '$$L^PSSLOCK(DFN,0)
- QUIT
- +5 DO NOW^%DTC
- SET PSJNOW=$EXTRACT(%,1,12)
- +6 SET PSJIDT=$$INSTLDT^PSJUTL1()
- IF PSJIDT=""
- SET PSJIDT=PSJNOW
- +7 SET $PIECE(^PS(55,DFN,5.1),U,11)=3
- +8 FOR ON=0:0
- SET ON=$ORDER(^PS(55,DFN,"IV",ON))
- if 'ON
- QUIT
- Begin DoDot:1
- +9 SET X=$GET(^PS(55,DFN,"IV",ON,2))
- +10 IF +X>PSJIDT
- QUIT
- +11 SET PSJPINIT=$PIECE(X,U,11)
- +12 NEW XX,XX1,PSJIEN
- +13 FOR XX=0:0
- SET XX=$ORDER(^PS(55,DFN,"IV",ON,"A",XX))
- if 'XX
- QUIT
- Begin DoDot:2
- +14 NEW PSJX
- SET XX1=$GET(^PS(55,DFN,"IV",ON,"A",XX,0))
- +15 if $PIECE(XX1,U,3)=""
- QUIT
- +16 KILL PSJIEN
- SET PSJX=""
- +17 IF $PIECE(XX1,U,6)=""
- Begin DoDot:3
- +18 DO NAME^PSJBCMA1($PIECE(XX1,U,3),,,.PSJIEN)
- +19 if PSJIEN>0
- SET $PIECE(^PS(55,DFN,"IV",ON,"A",XX,0),U,6)=PSJIEN
- SET XX1=^(0)
- End DoDot:3
- +20 if +$PIECE($GET(^PS(55,DFN,"IV",ON,4)),U,4)
- QUIT
- +21 IF $PIECE(XX1,U,2)="F"
- IF ($PIECE(XX1,U,4)'="FINISHED BY TECHNICIAN")
- SET PSJPINIT=$PIECE(XX1,U,6)
- SET PSJX=1
- +22 if $GET(PSJIEN)=-1
- SET ^XTMP("PSJ NEW PERSON",1,$PIECE(XX1,U,3),DFN,ON,XX)=PSJX
- End DoDot:2
- +23 if +PSJPINIT'>0
- QUIT
- +24 if +$PIECE($GET(^PS(55,DFN,"IV",ON,4)),U,4)
- QUIT
- +25 DO VF(ON,DFN,PSJPINIT,PSJNOW)
- End DoDot:1
- +26 DO UL^PSSLOCK(DFN)
- +27 QUIT
- VF(ON,DFN,PSJPINIT,PSJNOW) ; Update verifying pharm and date fields.
- +1 KILL DA,DIE,DR
- +2 SET PSIVACT=""
- +3 SET DIE="^PS(55,"_DFN_",""IV"","
- SET DA=ON
- SET DA(1)=DFN
- +4 SET DR="140////"_PSJPINIT_";141////"_PSJNOW_";142////1"
- DO ^DIE
- +5 SET ON55=ON
- SET PSIVREA="V"
- SET PSIVALT=""
- +6 SET PSIVAL="AUTO VERIFIED WITH PATCH PSJ*5*58"
- +7 DO LOG^PSIVORAL
- KILL PSIVAL,PSIVALT,PSIVREA
- +8 QUIT
- SEND(START) ;
- +1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,STOP,LINE
- +2 DO NOW^%DTC
- SET STOP=%
- +3 SET LINE(1)="Marking prior IV orders as verified started: "_$$FMTE^XLFDT(START)
- +4 SET LINE(2)="It ran to completion: "_$$FMTE^XLFDT(STOP)
- +5 IF $ORDER(^XTMP("PSJ NEW PERSON",0))
- Begin DoDot:1
- +6 SET LINE(3)=""
- +7 SET LINE(4)="Please assign the PSJI ACTIVITY LOG VA200 option to a holder of the"
- +8 SET LINE(5)="PSJI MGR key who is familiar with the Pharmacy users to correct any "
- +9 SET LINE(6)="names that the software was unable to match to the New Person file (#200)."
- End DoDot:1
- +10 SET XMSUB="PSJ*5*58 IV Verification"
- SET XMTEXT="LINE("
- +11 SET XMDUZ="PSJ*5*58"
- +12 SET XMY(+DUZ)=""
- DO ^XMD
- +13 QUIT
- +14 ;
- DMACTN ;Entry point for DM hidden action from backdoor LM OE *353
- +1 NEW GL,IFN,NXT,NODD,NXTROOT,ROOT,QQ
- +2 DO FULL^VALM1
- +3 WRITE #
- +4 SET (IFN,NXT,NODD)=0
- +5 ;Unit Dose backdoor New order entry in process Drug ien, but is OI ien when New IV's
- IF ((NAME["PSJ LM UD")!(NAME["PSJU LM"))
- IF $GET(PSGDRG)
- SET IFN=+PSGDRG
- DO SHOWDR
- +6 ;all other Unit dose input
- +7 ;Unit Dose DD mult
- IF ((NAME["PSJ LM UD")!(NAME["PSJU LM")!(NAME["PSJ LM PENDING"))
- IF '$GET(PSGDRG)
- Begin DoDot:1
- +8 IF $GET(PSGORD)["P"
- SET PSGOEEWF="^PS(53.1,"_+PSGORD_","
- +9 IF '$GET(PSGORD)
- IF ON["P"
- SET PSGOEEWF="^PS(53.1,"_+ON_","
- +10 FOR QQ=0:0
- SET ROOT=PSGOEEWF_"1,"_QQ_")"
- SET QQ=$ORDER(@ROOT)
- if 'QQ
- QUIT
- Begin DoDot:2
- +11 SET NODD=NODD+1
- SET NXTROOT=PSGOEEWF_"1,"_QQ_")"
- SET NXT=$ORDER(@NXTROOT)
- SET GL=$EXTRACT(NXTROOT,1,$LENGTH(ROOT)-1)
- SET IFN=+@(GL_",0)")
- +12 DO SHOWDR
- End DoDot:2
- End DoDot:1
- +13 ;all IV's
- +14 IF NAME["PSJ LM IV"
- Begin DoDot:1
- +15 if ON["P"
- SET PSGOEEWF="^PS(53.1,"_+ON_","
- +16 ;IV, Chk IV Additives
- if ON["V"
- SET PSGOEEWF="^PS(55,"_DFN_",""IV"","_+ON_","
- +17 FOR QQ=0:0
- SET ROOT=PSGOEEWF_"""AD"","_QQ_")"
- SET QQ=$ORDER(@ROOT)
- if 'QQ
- QUIT
- Begin DoDot:2
- +18 SET NODD=NODD+1
- SET NXTROOT=PSGOEEWF_"""AD"","_QQ_")"
- SET NXT=$ORDER(@NXTROOT)
- SET GL=$EXTRACT(NXTROOT,1,$LENGTH(ROOT)-1)
- SET IFN=+@(GL_",0)")
- if IFN
- SET IFN=+$PIECE($GET(^PS(52.6,IFN,0)),U,2)
- +19 DO SHOWDR
- End DoDot:2
- End DoDot:1
- +20 ;err, No IFN, No DD, & No IV Ads, display msg
- IF '$GET(PSGDRG)
- IF 'NODD
- DO SHOWDR
- +21 DO PICKDR
- +22 SET VALMBCK="R"
- +23 QUIT
- +24 ;
- PICKDR ;Entry point for Selecting a diff Drug
- +1 NEW IFN,Y
- +2 WRITE !
- KILL DIC
- SET DIC="^PSDRUG("
- SET DIC(0)="AEQMVTN"
- SET DIC("T")=""
- WRITE "Return to continue or"
- DO ^DIC
- KILL DIC
- IF Y<0
- QUIT
- +3 SET IFN=+Y
- +4 DO SHOWDR
- +5 GOTO PICKDR
- +6 ;
- SHOWDR ;Entry point to Display Drug hidden action info (via defaulted IFN)
- +1 NEW DIR,OIPTR
- +2 IF 'IFN
- WRITE !!,"** NO Dispense Drug entered for this order",!
- GOTO PICKDR
- +3 IF NODD=1
- IF NXT
- WRITE "** MULTIPLE DISP DRUGS **"
- +4 WRITE !,"DRUG NAME: ",$$GET1^DIQ(50,IFN_",","GENERIC NAME")," (IEN: "_IFN_")"
- +5 SET OIPTR=^PSDRUG(IFN,2)
- if $PIECE(OIPTR,"^",1)]""
- SET OIPTR=$PIECE(OIPTR,"^",1)
- +6 IF OIPTR]""
- WRITE !," ORDERABLE ITEM TEXT: ",!
- DO DMOITXT
- +7 WRITE !," MESSAGE: ",$$GET1^DIQ(50,IFN_",","MESSAGE")
- DO FULL
- +8 WRITE !," QTY DISP MESSAGE: ",$$GET1^DIQ(50,IFN_",","QUANTITY DISPENSE MESSAGE"),!
- DO FULL
- +9 KILL Y
- +10 QUIT
- +11 ;
- DMOITXT ;Get Pharmacy Orderable Item drug text fields
- +1 NEW DDD,QUIT,TEXT,TEXTPTR,TXT
- +2 IF $DATA(^PS(50.7,OIPTR,1,0))
- FOR TXT=0:0
- SET TXT=$ORDER(^PS(50.7,OIPTR,1,TXT))
- if 'TXT
- QUIT
- Begin DoDot:1
- +3 SET TEXTPTR=^PS(50.7,OIPTR,1,TXT,0)
- +4 FOR DDD=0:0
- SET DDD=$ORDER(^PS(51.7,TEXTPTR,2,DDD))
- if 'DDD
- QUIT
- IF '$$INACDATE
- SET TEXT=^PS(51.7,TEXTPTR,2,DDD,0)
- DO FULL
- if $GET(QUIT)
- QUIT
- WRITE " ",TEXT,!
- End DoDot:1
- +5 QUIT
- +6 ;
- FULL ;Screen is full, pause
- +1 if ($Y+3)>IOSL&('$GET(QUIT))
- DO FSCRN
- +2 QUIT
- +3 ;
- FSCRN ;User Wait as screen if full
- +1 if $GET(QUIT)
- QUIT
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue,'^' to exit"
- DO ^DIR
- WRITE @IOF
- if Y'=1
- SET QUIT=1
- +2 QUIT
- +3 ;
- INACDATE() ;Check Inactive date
- +1 QUIT $PIECE($GET(^PS(51.7,TEXTPTR,0)),"^",2)
- +2 ;
- VPACTN ;Entry point for VP hidden action from PSJ OE-testing bg *353
- +1 DO FULL^VALM1
- +2 NEW IFN
- SET IFN=+$GET(P("6"))
- IF 'IFN
- SET IFN=+$GET(PSGPR)
- +3 DO SHOWVP
- +4 SET VALMBCK="R"
- +5 QUIT
- +6 ;
- PICKVP ;Entry Point For Selecting a diff provider
- +1 NEW IFN,Y
- +2 WRITE !
- KILL DIC
- SET DIC="^VA(200,"
- SET DIC(0)="AEQMVTN"
- SET DIC("T")=""
- WRITE !,"Return to continue or"
- DO ^DIC
- KILL DIC
- IF Y<0
- QUIT
- +3 SET IFN=+Y
- +4 ;
- SHOWVP ;Entry point to Display Provider hidden action info (via defaulted IFN)
- +1 NEW DIR
- +2 IF 'IFN
- WRITE !,"No provider entered for this order",!
- GOTO PICKVP
- +3 WRITE #,"PROVIDER TITLE: ",$$GET1^DIQ(200,IFN_",","TITLE")
- +4 WRITE !!,"PROVIDER REMARKS: ",$$GET1^DIQ(200,IFN_",","REMARKS")
- +5 WRITE !!,"PROVIDER SPECIALTY: ",$$GET1^DIQ(200,IFN_",","PROVIDER CLASS"),!," "_$$GET1^DIQ(200,IFN_",","SERVICE/SECTION")
- +6 KILL Y
- +7 GOTO PICKVP
- +8 QUIT
- +9 ;
- DELNV(DFN,ORDER) ; Deletes/Resets Nurse Verification in PHARMACY PATIENT file (#55), used by BCMA
- +1 ;Input: DFN - Pointer the PATIENT file (#2)
- +2 ; ORDER - Pointer to ORDER sub-file in file #55 (e.g., "124U", "321V")
- +3 IF $PIECE($GET(^PS(55,+$GET(DFN),$SELECT(ORDER["V":"IV",1:5),+$GET(ORDER),4)),"^",10)
- Begin DoDot:1
- +4 SET $PIECE(^PS(55,DFN,$SELECT(ORDER["V":"IV",1:5),+ORDER,4),"^",1)=""
- +5 SET $PIECE(^PS(55,DFN,$SELECT(ORDER["V":"IV",1:5),+ORDER,4),"^",2)=""
- +6 SET $PIECE(^PS(55,DFN,$SELECT(ORDER["V":"IV",1:5),+ORDER,4),"^",10)=0
- End DoDot:1
- +7 QUIT