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 Dec 13, 2024@02:09:13 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
