PXVRESP ;BIR/ADM - VIMM DEFAULT RESPONSE FILE UTILITIES ;Jun 09, 2021@06:25:17
;;1.0;PCE PATIENT CARE ENCOUNTER;**215,217**;Aug 12, 1996;Build 134
;
Q
DEF ; edit immunization default responses file
N PXVDIV,PXVHD1,PXVHDR,PXVN,PXVNAME,PXVNUM,PXVOUT,PXVBY
N DA,DIC,DIDEL,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
;
S PXVOUT=0
S (DIDEL,DLAYGO)=920.05
S PXVHD1="Enter/Edit Immunization/Contra/Refusal Default Responses"
W @IOF,!,?10,PXVHD1,!
K DIC S DIC="^PXV(920.05,",DIC(0)="AEMLZ",DIC("A")="Select Facility: " D ^DIC
K DIC I $D(DTOUT)!$D(DUOUT)!(X="") S PXVOUT=1 D END Q
S PXVDIV=+Y,PXVN=+Y(0),PXVNAME=Y(0,0),PXVNUM=$$GET1^DIQ(4,PXVN,99),PXVHDR="Facility: "_PXVNAME_" ("_PXVNUM_")"
;
W !
S DIR(0)="SA^I:Immunizations;C:Contraindications/Refusals"
S DIR("A")="Do you want to enter defaults for (I)mmunizations or (C)ontra/Refusals? "
D ^DIR
I $D(DIRUT) S PXVOUT=1 D END Q
S PXVBY=Y
I PXVBY'="I",PXVBY'="C" S PXVOUT=1 D END Q
I PXVBY="I" S PXVHD1="Enter/Edit Immunization Default Responses"
I PXVBY="C" S PXVHD1="Enter/Edit Contra/Refusal Default Responses"
;
W @IOF,!,?10,PXVHD1,!!,PXVHDR,!
S DA=PXVDIV
S DIE=920.05
I PXVBY="I" S DR="1",DR(2,920.051)=".01;1302;1303;1312;1313;1314;81101;"
I PXVBY="C" S DR="2",DR(2,920.052)=".01;.02"
D ^DIE
I $D(Y) D END Q
;
END K DA,DIE,DIC,DIDEL,DLAYGO,DR,DTOUT,DUOUT,X,Y
Q
;
INST(PXVIS) ; returns facility ien in file #920.05 related to this immunization
; PXVIS - ien of visit in file #9000010
N PXVINST,PXVFAC,PXVHL,PXVN,PXVPRNT,PXVSTN
S PXVFAC="",PXVN=$O(^PXV(920.05,0)) I 'PXVN Q PXVFAC
I $G(PXVIS) D
.S PXVHL=$P($G(^AUPNVSIT(PXVIS,0)),"^",22) I 'PXVHL Q
.S PXVINST=$P(^SC(PXVHL,0),"^",4) I 'PXVINST Q
.S PXVFAC=$O(^PXV(920.05,"B",PXVINST,0))
.I 'PXVFAC D
..S PXVSTN=$$STA^XUAF4(PXVINST) Q:PXVSTN=""
..S PXVPRNT=$P($$PRNT^XUAF4(PXVSTN),"^")
..S PXVFAC=$O(^PXV(920.05,"B",PXVPRNT,0))
I 'PXVFAC,+$G(DUZ(2)) D
.S PXVINST=$G(DUZ(2))
.S PXVFAC=$O(^PXV(920.05,"B",PXVINST,0))
.I 'PXVFAC D
..S PXVSTN=$$STA^XUAF4(PXVINST) Q:PXVSTN=""
..S PXVPRNT=$P($$PRNT^XUAF4(PXVSTN),"^")
..S PXVFAC=$O(^PXV(920.05,"B",PXVPRNT,0))
Q PXVFAC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVRESP 2167 printed Oct 16, 2024@18:32:33 Page 2
PXVRESP ;BIR/ADM - VIMM DEFAULT RESPONSE FILE UTILITIES ;Jun 09, 2021@06:25:17
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215,217**;Aug 12, 1996;Build 134
+2 ;
+3 QUIT
DEF ; edit immunization default responses file
+1 NEW PXVDIV,PXVHD1,PXVHDR,PXVN,PXVNAME,PXVNUM,PXVOUT,PXVBY
+2 NEW DA,DIC,DIDEL,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
+3 ;
+4 SET PXVOUT=0
+5 SET (DIDEL,DLAYGO)=920.05
+6 SET PXVHD1="Enter/Edit Immunization/Contra/Refusal Default Responses"
+7 WRITE @IOF,!,?10,PXVHD1,!
+8 KILL DIC
SET DIC="^PXV(920.05,"
SET DIC(0)="AEMLZ"
SET DIC("A")="Select Facility: "
DO ^DIC
+9 KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
SET PXVOUT=1
DO END
QUIT
+10 SET PXVDIV=+Y
SET PXVN=+Y(0)
SET PXVNAME=Y(0,0)
SET PXVNUM=$$GET1^DIQ(4,PXVN,99)
SET PXVHDR="Facility: "_PXVNAME_" ("_PXVNUM_")"
+11 ;
+12 WRITE !
+13 SET DIR(0)="SA^I:Immunizations;C:Contraindications/Refusals"
+14 SET DIR("A")="Do you want to enter defaults for (I)mmunizations or (C)ontra/Refusals? "
+15 DO ^DIR
+16 IF $DATA(DIRUT)
SET PXVOUT=1
DO END
QUIT
+17 SET PXVBY=Y
+18 IF PXVBY'="I"
IF PXVBY'="C"
SET PXVOUT=1
DO END
QUIT
+19 IF PXVBY="I"
SET PXVHD1="Enter/Edit Immunization Default Responses"
+20 IF PXVBY="C"
SET PXVHD1="Enter/Edit Contra/Refusal Default Responses"
+21 ;
+22 WRITE @IOF,!,?10,PXVHD1,!!,PXVHDR,!
+23 SET DA=PXVDIV
+24 SET DIE=920.05
+25 IF PXVBY="I"
SET DR="1"
SET DR(2,920.051)=".01;1302;1303;1312;1313;1314;81101;"
+26 IF PXVBY="C"
SET DR="2"
SET DR(2,920.052)=".01;.02"
+27 DO ^DIE
+28 IF $DATA(Y)
DO END
QUIT
+29 ;
END KILL DA,DIE,DIC,DIDEL,DLAYGO,DR,DTOUT,DUOUT,X,Y
+1 QUIT
+2 ;
INST(PXVIS) ; returns facility ien in file #920.05 related to this immunization
+1 ; PXVIS - ien of visit in file #9000010
+2 NEW PXVINST,PXVFAC,PXVHL,PXVN,PXVPRNT,PXVSTN
+3 SET PXVFAC=""
SET PXVN=$ORDER(^PXV(920.05,0))
IF 'PXVN
QUIT PXVFAC
+4 IF $GET(PXVIS)
Begin DoDot:1
+5 SET PXVHL=$PIECE($GET(^AUPNVSIT(PXVIS,0)),"^",22)
IF 'PXVHL
QUIT
+6 SET PXVINST=$PIECE(^SC(PXVHL,0),"^",4)
IF 'PXVINST
QUIT
+7 SET PXVFAC=$ORDER(^PXV(920.05,"B",PXVINST,0))
+8 IF 'PXVFAC
Begin DoDot:2
+9 SET PXVSTN=$$STA^XUAF4(PXVINST)
if PXVSTN=""
QUIT
+10 SET PXVPRNT=$PIECE($$PRNT^XUAF4(PXVSTN),"^")
+11 SET PXVFAC=$ORDER(^PXV(920.05,"B",PXVPRNT,0))
End DoDot:2
End DoDot:1
+12 IF 'PXVFAC
IF +$GET(DUZ(2))
Begin DoDot:1
+13 SET PXVINST=$GET(DUZ(2))
+14 SET PXVFAC=$ORDER(^PXV(920.05,"B",PXVINST,0))
+15 IF 'PXVFAC
Begin DoDot:2
+16 SET PXVSTN=$$STA^XUAF4(PXVINST)
if PXVSTN=""
QUIT
+17 SET PXVPRNT=$PIECE($$PRNT^XUAF4(PXVSTN),"^")
+18 SET PXVFAC=$ORDER(^PXV(920.05,"B",PXVPRNT,0))
End DoDot:2
End DoDot:1
+19 QUIT PXVFAC
