- 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
