BDGPARM ; IHS/ANMC/LJF - IHS ADT PARAMETERS ;
;;5.3;PIMS;**1004**;MAY 28, 2004
;IHS/OIT/LJF 08/31/2005 PATCH 1004 add "Print Wristband" question to DR string
;
NEW BDGERR,BDGIV,DIE,DA,DR,BDGF,BDGN
;
; -- get MAS Parameter file entry (only one allowed) and edit
I '$D(^DG(43,1)) D I $G(BDGERR)]"" D MSG^BDGF(BDGERR,1,0) Q
. S BDGIV=$$CHOOSE(43,1,.BDGERR)
Q:'$D(^DG(43,1,0))
;
D TERM^VALM0
D MSG^BDGF($G(IORVON)_"Editing system-wide parameters:"_$G(IORVOFF),1,1)
S DIE=43,DA=1,DR="12T;11;205///5.3" D ^DIE Q:$D(Y)
D MSG^BDGF($G(IORVON)_"Editing facility-wide parameters:"_$G(IORVOFF),3,1)
;
; -- if no entry in IHS ADT Parameter file, add one
;
I '$O(^BDGPAR(0)) D I $G(BDGERR) D MSG^BDGF(BDGERR,1,0) Q
. ;
. ; if no medical center division or > 1, add or choose one
. S BDGF=$O(^DG(40.8,0))
. I 'BDGF!$O(^DG(40.8,+BDGF)) S BDGF=+$$CHOOSE(40.8,"",.BDGERR)
. Q:BDGF<1
. ;
. ; add ihs adt parameter entry to match
. S BDGF=+$$CHOOSE(9009020.1,BDGF,.BDGERR)
;
AGAIN ;
; -- else choose facility to edit
I '$G(BDGF) S BDGF=+$$CHOOSE(9009020.1,"",.BDGERR) Q:BDGF<1
I $G(BDGERR)]"" D MSG^BDGF(BDGERR,1,0) Q
;
; -- check stuffed fields for IHS answers
S DIE=40.8,DA=BDGF
;S DR=".07;1;35.01///^S X=""NO"";35.03///^S X=""NO"";100.01///0"
S DR=".07;1;35.01///^S X=""NO"";35.03///^S X=""NO"";100.01///0;.08" ;IHS/OIT/LJF 8/31/2005 PATCH 1004
D ^DIE Q:$D(Y)
;
; -- check PCC Master Control file for PCC link turned on
S BDGN=$P($G(^DG(40.8,BDGF,0)),U,7) I BDGN D
. Q ;TEMP FOR TESTING IN VA UCI
. NEW DIE,DR,DA
. S DIE=9001000.011,DA(1)=BDGN,DR=".02"
. S DA=$O(^DIC(9.4,"C","DG",0)) I DA D ^DIE
;
; -- call ScreenMan to add/edit parameters
NEW DDSFILE,DA,DR
S DDSFILE=9009020.1,DA=BDGF,DR="[BDG PARAM]" D ^DDS
K BDGF D AGAIN
Q
;
;
CHOOSE(FILE,ENTRY,ERROR) ; calls DIC for file, add allowed
NEW DD,DO,DIC,DLAYGO,X,DINUM
K DD,DO S (DIC,DLAYGO)=FILE,DIC(0)="AMEQZL"
I ENTRY]"" S (X,DINUM)=ENTRY D FILE^DICN I Y=-1 S ERROR="Adding entry to file "_FILE_" failed; contact supervisor." Q Y
D ^DIC
Q Y
BDGPARM ; IHS/ANMC/LJF - IHS ADT PARAMETERS ;
+1 ;;5.3;PIMS;**1004**;MAY 28, 2004
+2 ;IHS/OIT/LJF 08/31/2005 PATCH 1004 add "Print Wristband" question to DR string
+3 ;
+4 NEW BDGERR,BDGIV,DIE,DA,DR,BDGF,BDGN
+5 ;
+6 ; -- get MAS Parameter file entry (only one allowed) and edit
+7 IF '$DATA(^DG(43,1))
Begin DoDot:1
+8 SET BDGIV=$$CHOOSE(43,1,.BDGERR)
End DoDot:1
IF $GET(BDGERR)]""
DO MSG^BDGF(BDGERR,1,0)
QUIT
+9 IF '$DATA(^DG(43,1,0))
QUIT
+10 ;
+11 DO TERM^VALM0
+12 DO MSG^BDGF($GET(IORVON)_"Editing system-wide parameters:"_$GET(IORVOFF),1,1)
+13 SET DIE=43
SET DA=1
SET DR="12T;11;205///5.3"
DO ^DIE
IF $DATA(Y)
QUIT
+14 DO MSG^BDGF($GET(IORVON)_"Editing facility-wide parameters:"_$GET(IORVOFF),3,1)
+15 ;
+16 ; -- if no entry in IHS ADT Parameter file, add one
+17 ;
+18 IF '$ORDER(^BDGPAR(0))
Begin DoDot:1
+19 ;
+20 ; if no medical center division or > 1, add or choose one
+21 SET BDGF=$ORDER(^DG(40.8,0))
+22 IF 'BDGF!$ORDER(^DG(40.8,+BDGF))
SET BDGF=+$$CHOOSE(40.8,"",.BDGERR)
+23 IF BDGF<1
QUIT
+24 ;
+25 ; add ihs adt parameter entry to match
+26 SET BDGF=+$$CHOOSE(9009020.1,BDGF,.BDGERR)
End DoDot:1
IF $GET(BDGERR)
DO MSG^BDGF(BDGERR,1,0)
QUIT
+27 ;
AGAIN ;
+1 ; -- else choose facility to edit
+2 IF '$GET(BDGF)
SET BDGF=+$$CHOOSE(9009020.1,"",.BDGERR)
IF BDGF<1
QUIT
+3 IF $GET(BDGERR)]""
DO MSG^BDGF(BDGERR,1,0)
QUIT
+4 ;
+5 ; -- check stuffed fields for IHS answers
+6 SET DIE=40.8
SET DA=BDGF
+7 ;S DR=".07;1;35.01///^S X=""NO"";35.03///^S X=""NO"";100.01///0"
+8 ;IHS/OIT/LJF 8/31/2005 PATCH 1004
SET DR=".07;1;35.01///^S X=""NO"";35.03///^S X=""NO"";100.01///0;.08"
+9 DO ^DIE
IF $DATA(Y)
QUIT
+10 ;
+11 ; -- check PCC Master Control file for PCC link turned on
+12 SET BDGN=$PIECE($GET(^DG(40.8,BDGF,0)),U,7)
IF BDGN
Begin DoDot:1
+13 ;TEMP FOR TESTING IN VA UCI
QUIT
+14 NEW DIE,DR,DA
+15 SET DIE=9001000.011
SET DA(1)=BDGN
SET DR=".02"
+16 SET DA=$ORDER(^DIC(9.4,"C","DG",0))
IF DA
DO ^DIE
End DoDot:1
+17 ;
+18 ; -- call ScreenMan to add/edit parameters
+19 NEW DDSFILE,DA,DR
+20 SET DDSFILE=9009020.1
SET DA=BDGF
SET DR="[BDG PARAM]"
DO ^DDS
+21 KILL BDGF
DO AGAIN
+22 QUIT
+23 ;
+24 ;
CHOOSE(FILE,ENTRY,ERROR) ; calls DIC for file, add allowed
+1 NEW DD,DO,DIC,DLAYGO,X,DINUM
+2 KILL DD,DO
SET (DIC,DLAYGO)=FILE
SET DIC(0)="AMEQZL"
+3 IF ENTRY]""
SET (X,DINUM)=ENTRY
DO FILE^DICN
IF Y=-1
SET ERROR="Adding entry to file "_FILE_" failed; contact supervisor."
QUIT Y
+4 DO ^DIC
+5 QUIT Y
