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

PXVRESP.m

Go to the documentation of this file.
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