BDGVAR ; IHS/ANMC/LJF - VARIABLE SET AND KILL ; [ 01/02/2004 10:27 AM ]
;;5.3;PIMS;**1011,1012**;APR 26, 2002
;
ENTER ;EP; entry point called by main menu
I $G(BDGQUIT) K BDGQUIT Q ;don't call this twice
NEW I,X
S BDGMENU=1
D ^XBCLS W @IOF W !?27 F I=1:1:25 W "*"
W !?24,"** INDIAN HEALTH SERVICE **"
W !?19,"** ADMISSION/DISCHARGE/TRANSFER SYSTEM **"
W !?24,"** VERSION ",$$VERSION^XPDUTL("DG"),?53,"**"
W !?27 F I=1:1:25 W "*"
;
I '$D(DUZ(2)) D S XQUIT=1 D PAUSE^BDGF Q
. W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE ADT!"
;
S X=$$GET1^DIQ(4,DUZ(2),.01) W !!?80-$L(X)\2,X
I X="" D S XQUIT=1 D PAUSE^BDGF Q
. W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"
;
I $D(XQUIT) D EXIT Q
Q
;
VAR ;PEP;***> set package variables from site parameter file
Q:$G(XQUIT)
;
; set system-wide variables
; -- set division based on DUZ(2)
S BDGDIV=$$DIV^BDGPAR(DUZ(2))
Q
;
CHECK(TALK) ;PEP; check that ADT is set up and PCC link is turned on
; TALK = 1 means display mini message to screen
; TALK = 2 means display full message to screen
; TALK = 0 means no display; just return status
;
; Returns 1 if ADT set up but PCC link is off
; Returns 2 if ADT set up and PCC link is on
; Returns 0 if ADT not set up - do not continue
;
; If TALK not = 2 and ADT not set up, XQUIT set to 1
;
NEW I,STATUS,X,Y
; -- display heading
I TALK=2 D
. D ^XBCLS W !?25,"ADT-PCC LINK ENVIRONMENT"
. W !?25 F I=1:1:24 W "-"
;
I '$D(^AUTTSITE(1,0)) D Q 0
. I TALK=2 W !!?10,"1) RPMS SITE file is NOT present."
. I TALK=1 W !?9,"** ADT is NOT set up properly; contact application coordinator. **" D PAUSE^BDGF
. I TALK'=2 S XQUIT=1
;
S STATUS=2 ;start with best case
S X=$$GET1^DIQ(9999999.39,1,.08) I X'="YES" S STATUS=1
I TALK=2 W !!?10,"1) PCC is running at this site (RPMS SITE file): ",X
;
S X=$D(^APCCCTRL(DUZ(2))) I 'X S STATUS=1
I TALK=2 W !!?10,"2) PCC MASTER CONTROL file is defined for this site: ",$S(X:"YES",1:"NO")
;
S X=$$GET1^DIQ(9001000,DUZ(2),.04) I X="" S STATUS=1
I TALK=2 W !!?10,"3) VISIT TYPE defined in the PCC MASTER CONTROL file: ",X
;
S X=0,Y=0 F S X=$O(^BDGPAR(X)) Q:'X Q:Y D
. ;I $D(^DG(40.8,"C",DUZ(2),X)) S Y=X ;cmi/maw 9/1/09 orig line PATCH 1011
. I $D(^DG(40.8,"AD",DUZ(2),X)) S Y=X ;cmi/maw 9/1/09 mod line PATCH 1011
I 'Y S STATUS=0
I TALK=2 W !?10,"4) ADT Division in IHS ADT PARAMETER file: ",$S('Y:"NO",1:$$GET1^DIQ(40.8,Y,.01))
;
S X=$O(^DIC(9.4,"C","PIMS",0)) I TALK=2 W !!?10,"5) PIMS package defined in the PACKAGE file: ",$S(X:"YES",1:"NO")
I 'X S STATUS=0
;
S Y=$S($D(^APCCCTRL(DUZ(2),11,+X,0)):"YES",1:"NO")
I Y="NO",STATUS S STATUS=1
I TALK=2 W !!?10,"6) PIMS entry exists in the PCC MASTER CONTROL file: ",Y
;
I $D(^APCCCTRL(DUZ(2),11,+X,0)),STATUS D
. S Y=+$P(^APCCCTRL(DUZ(2),11,+X,0),U,2) I 'Y S STATUS=1
. I TALK=2 D
.. W !!?10,"7) PIMS entry has ""PASS DATA TO PCC"" set to: "
.. W $S(Y:"YES",1:"NO")
;
I TALK D
. I STATUS=0 S X="** ADT is NOT set up properly; contact application coordinator. **"
. I STATUS=1 S X="** PCC link is turned OFF. **"
. I STATUS=2 S X="** PCC link is turned ON. **"
. I TALK=2 W !!?(80-$L(X)/2),X Q
. I STATUS=0 W !?(80-$L(X)/2),X I '$D(^XUSEC("DGZSYS",DUZ)) D PAUSE^BDGF S XQUIT=1 Q
. I STATUS,$D(^XUSEC("DGZSYS",DUZ)) W !?(80-$L(X)/2),X
;
Q STATUS
;
EXIT ;PEP; kill system wide variables
K BDGMENU,BDGDIV,BDGQUIT
D EN^XBVK("VALM")
Q
;
NEW BDG
S BDG("TITLE")=$P($G(XQY0),U,2)
I $L(BDG("TITLE"))>2 W @IOF,!!?80-$L(BDG("TITLE"))/2,BDG("TITLE")
S X=$$GET1^DIQ(4,DUZ(2),.01)
W !!?80-$L(X)\2,"(",X,")"
Q
;
SECENTER ;EP; entry point for Security Officer Menu
;Part of PIMS but released with DPT so use DPT version #
;
D ^XBCLS W !?18 F BDG("I")=1:1:41 W "*"
W !?18,"* INDIAN HEALTH SERVICE *"
W !?18,"* SENSITIVE PATIENT TRACKING MODULE *"
W !?18,"* VERSION ",$$VERSION^XPDUTL("PIMS"),?58,"*"
W !?18 F BDG("I")=1:1:41 W "*"
;
I '$D(DUZ(2))!('$D(DUZ(0))) D D SECQUIT Q
.W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE THIS MENU"
.S XQUIT=1 D PAUSE^BDGF
S X=$$GET1^DIQ(4,DUZ(2),.01) W !!?80-$L(X)\2,X
I X="" W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!" S XQUIT=1
;
SECQUIT W ! K BDG,X,Y Q
BDGVAR ; IHS/ANMC/LJF - VARIABLE SET AND KILL ; [ 01/02/2004 10:27 AM ]
+1 ;;5.3;PIMS;**1011,1012**;APR 26, 2002
+2 ;
ENTER ;EP; entry point called by main menu
+1 ;don't call this twice
IF $GET(BDGQUIT)
KILL BDGQUIT
QUIT
+2 NEW I,X
+3 SET BDGMENU=1
+4 DO ^XBCLS
WRITE @IOF
WRITE !?27
FOR I=1:1:25
WRITE "*"
+5 WRITE !?24,"** INDIAN HEALTH SERVICE **"
+6 WRITE !?19,"** ADMISSION/DISCHARGE/TRANSFER SYSTEM **"
+7 WRITE !?24,"** VERSION ",$$VERSION^XPDUTL("DG"),?53,"**"
+8 WRITE !?27
FOR I=1:1:25
WRITE "*"
+9 ;
+10 IF '$DATA(DUZ(2))
Begin DoDot:1
+11 WRITE !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE ADT!"
End DoDot:1
SET XQUIT=1
DO PAUSE^BDGF
QUIT
+12 ;
+13 SET X=$$GET1^DIQ(4,DUZ(2),.01)
WRITE !!?80-$LENGTH(X)\2,X
+14 IF X=""
Begin DoDot:1
+15 WRITE !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"
End DoDot:1
SET XQUIT=1
DO PAUSE^BDGF
QUIT
+16 ;
+17 IF $DATA(XQUIT)
DO EXIT
QUIT
+18 QUIT
+19 ;
VAR ;PEP;***> set package variables from site parameter file
+1 IF $GET(XQUIT)
QUIT
+2 ;
+3 ; set system-wide variables
+4 ; -- set division based on DUZ(2)
+5 SET BDGDIV=$$DIV^BDGPAR(DUZ(2))
+6 QUIT
+7 ;
CHECK(TALK) ;PEP; check that ADT is set up and PCC link is turned on
+1 ; TALK = 1 means display mini message to screen
+2 ; TALK = 2 means display full message to screen
+3 ; TALK = 0 means no display; just return status
+4 ;
+5 ; Returns 1 if ADT set up but PCC link is off
+6 ; Returns 2 if ADT set up and PCC link is on
+7 ; Returns 0 if ADT not set up - do not continue
+8 ;
+9 ; If TALK not = 2 and ADT not set up, XQUIT set to 1
+10 ;
+11 NEW I,STATUS,X,Y
+12 ; -- display heading
+13 IF TALK=2
Begin DoDot:1
+14 DO ^XBCLS
WRITE !?25,"ADT-PCC LINK ENVIRONMENT"
+15 WRITE !?25
FOR I=1:1:24
WRITE "-"
End DoDot:1
+16 ;
+17 IF '$DATA(^AUTTSITE(1,0))
Begin DoDot:1
+18 IF TALK=2
WRITE !!?10,"1) RPMS SITE file is NOT present."
+19 IF TALK=1
WRITE !?9,"** ADT is NOT set up properly; contact application coordinator. **"
DO PAUSE^BDGF
+20 IF TALK'=2
SET XQUIT=1
End DoDot:1
QUIT 0
+21 ;
+22 ;start with best case
SET STATUS=2
+23 SET X=$$GET1^DIQ(9999999.39,1,.08)
IF X'="YES"
SET STATUS=1
+24 IF TALK=2
WRITE !!?10,"1) PCC is running at this site (RPMS SITE file): ",X
+25 ;
+26 SET X=$DATA(^APCCCTRL(DUZ(2)))
IF 'X
SET STATUS=1
+27 IF TALK=2
WRITE !!?10,"2) PCC MASTER CONTROL file is defined for this site: ",$SELECT(X:"YES",1:"NO")
+28 ;
+29 SET X=$$GET1^DIQ(9001000,DUZ(2),.04)
IF X=""
SET STATUS=1
+30 IF TALK=2
WRITE !!?10,"3) VISIT TYPE defined in the PCC MASTER CONTROL file: ",X
+31 ;
+32 SET X=0
SET Y=0
FOR
SET X=$ORDER(^BDGPAR(X))
IF 'X
QUIT
IF Y
QUIT
Begin DoDot:1
+33 ;I $D(^DG(40.8,"C",DUZ(2),X)) S Y=X ;cmi/maw 9/1/09 orig line PATCH 1011
+34 ;cmi/maw 9/1/09 mod line PATCH 1011
IF $DATA(^DG(40.8,"AD",DUZ(2),X))
SET Y=X
End DoDot:1
+35 IF 'Y
SET STATUS=0
+36 IF TALK=2
WRITE !?10,"4) ADT Division in IHS ADT PARAMETER file: ",$SELECT('Y:"NO",1:$$GET1^DIQ(40.8,Y,.01))
+37 ;
+38 SET X=$ORDER(^DIC(9.4,"C","PIMS",0))
IF TALK=2
WRITE !!?10,"5) PIMS package defined in the PACKAGE file: ",$SELECT(X:"YES",1:"NO")
+39 IF 'X
SET STATUS=0
+40 ;
+41 SET Y=$SELECT($DATA(^APCCCTRL(DUZ(2),11,+X,0)):"YES",1:"NO")
+42 IF Y="NO"
IF STATUS
SET STATUS=1
+43 IF TALK=2
WRITE !!?10,"6) PIMS entry exists in the PCC MASTER CONTROL file: ",Y
+44 ;
+45 IF $DATA(^APCCCTRL(DUZ(2),11,+X,0))
IF STATUS
Begin DoDot:1
+46 SET Y=+$PIECE(^APCCCTRL(DUZ(2),11,+X,0),U,2)
IF 'Y
SET STATUS=1
+47 IF TALK=2
Begin DoDot:2
+48 WRITE !!?10,"7) PIMS entry has ""PASS DATA TO PCC"" set to: "
+49 WRITE $SELECT(Y:"YES",1:"NO")
End DoDot:2
End DoDot:1
+50 ;
+51 IF TALK
Begin DoDot:1
+52 IF STATUS=0
SET X="** ADT is NOT set up properly; contact application coordinator. **"
+53 IF STATUS=1
SET X="** PCC link is turned OFF. **"
+54 IF STATUS=2
SET X="** PCC link is turned ON. **"
+55 IF TALK=2
WRITE !!?(80-$LENGTH(X)/2),X
QUIT
+56 IF STATUS=0
WRITE !?(80-$LENGTH(X)/2),X
IF '$DATA(^XUSEC("DGZSYS",DUZ))
DO PAUSE^BDGF
SET XQUIT=1
QUIT
+57 IF STATUS
IF $DATA(^XUSEC("DGZSYS",DUZ))
WRITE !?(80-$LENGTH(X)/2),X
End DoDot:1
+58 ;
+59 QUIT STATUS
+60 ;
EXIT ;PEP; kill system wide variables
+1 KILL BDGMENU,BDGDIV,BDGQUIT
+2 DO EN^XBVK("VALM")
+3 QUIT
+4 ;
+1 NEW BDG
+2 SET BDG("TITLE")=$PIECE($GET(XQY0),U,2)
+3 IF $LENGTH(BDG("TITLE"))>2
WRITE @IOF,!!?80-$LENGTH(BDG("TITLE"))/2,BDG("TITLE")
+4 SET X=$$GET1^DIQ(4,DUZ(2),.01)
+5 WRITE !!?80-$LENGTH(X)\2,"(",X,")"
+6 QUIT
+7 ;
SECENTER ;EP; entry point for Security Officer Menu
+1 ;Part of PIMS but released with DPT so use DPT version #
+2 ;
+3 DO ^XBCLS
WRITE !?18
FOR BDG("I")=1:1:41
WRITE "*"
+4 WRITE !?18,"* INDIAN HEALTH SERVICE *"
+5 WRITE !?18,"* SENSITIVE PATIENT TRACKING MODULE *"
+6 WRITE !?18,"* VERSION ",$$VERSION^XPDUTL("PIMS"),?58,"*"
+7 WRITE !?18
FOR BDG("I")=1:1:41
WRITE "*"
+8 ;
+9 IF '$DATA(DUZ(2))!('$DATA(DUZ(0)))
Begin DoDot:1
+10 WRITE !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE THIS MENU"
+11 SET XQUIT=1
DO PAUSE^BDGF
End DoDot:1
DO SECQUIT
QUIT
+12 SET X=$$GET1^DIQ(4,DUZ(2),.01)
WRITE !!?80-$LENGTH(X)\2,X
+13 IF X=""
WRITE !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"
SET XQUIT=1
+14 ;
SECQUIT WRITE !
KILL BDG,X,Y
QUIT
