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

BDGVAR.m

Go to the documentation of this file. 
  1. BDGVAR ; IHS/ANMC/LJF - VARIABLE SET AND KILL ;  [ 01/02/2004  10:27 AM ]
  1.  ;;5.3;PIMS;**1011,1012**;APR 26, 2002
  1.  ;
  1. ENTER ;EP; entry point called by main menu
  1.  I $G(BDGQUIT) K BDGQUIT Q   ;don't call this twice
  1.  NEW I,X
  1.  S BDGMENU=1
  1.  D ^XBCLS W @IOF W !?27 F I=1:1:25 W "*"
  1.  W !?24,"**   INDIAN HEALTH SERVICE   **"
  1.  W !?19,"** ADMISSION/DISCHARGE/TRANSFER SYSTEM **"
  1.  W !?24,"**       VERSION ",$$VERSION^XPDUTL("DG"),?53,"**"
  1.  W !?27 F I=1:1:25 W "*"
  1.  ;
  1.  I '$D(DUZ(2)) D  S XQUIT=1 D PAUSE^BDGF Q
  1.  . W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE ADT!"
  1.  ;
  1.  S X=$$GET1^DIQ(4,DUZ(2),.01) W !!?80-$L(X)\2,X
  1.  I X="" D  S XQUIT=1 D PAUSE^BDGF Q
  1.  . W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"
  1.  ;
  1.  I $D(XQUIT) D EXIT Q
  1.  Q
  1.  ;
  1. VAR ;PEP;***> set package variables from site parameter file
  1.  Q:$G(XQUIT)
  1.  ;
  1.  ; set system-wide variables
  1.  ;   -- set division based on DUZ(2)
  1.  S BDGDIV=$$DIV^BDGPAR(DUZ(2))
  1.  Q
  1.  ;
  1. CHECK(TALK) ;PEP; check that ADT is set up and PCC link is turned on
  1.  ; TALK = 1 means display mini message to screen
  1.  ; TALK = 2 means display full message to screen
  1.  ; TALK = 0 means no display; just return status
  1.  ;
  1.  ; Returns 1 if ADT set up but PCC link is off
  1.  ; Returns 2 if ADT set up and PCC link is on
  1.  ; Returns 0 if ADT not set up - do not continue
  1.  ;
  1.  ; If TALK not = 2 and ADT not set up, XQUIT set to 1
  1.  ;
  1.  NEW I,STATUS,X,Y
  1.  ; -- display heading
  1.  I TALK=2 D
  1.  . D ^XBCLS W !?25,"ADT-PCC LINK ENVIRONMENT"
  1.  . W !?25 F I=1:1:24 W "-"
  1.  ;
  1.  I '$D(^AUTTSITE(1,0)) D  Q 0
  1.  . I TALK=2 W !!?10,"1) RPMS SITE file is NOT present."
  1.  . I TALK=1 W !?9,"** ADT is NOT set up properly; contact application coordinator. **" D PAUSE^BDGF
  1.  . I TALK'=2 S XQUIT=1
  1.  ;
  1.  S STATUS=2   ;start with best case
  1.  S X=$$GET1^DIQ(9999999.39,1,.08) I X'="YES" S STATUS=1
  1.  I TALK=2 W !!?10,"1) PCC is running at this site (RPMS SITE file): ",X
  1.  ;
  1.  S X=$D(^APCCCTRL(DUZ(2))) I 'X S STATUS=1
  1.  I TALK=2 W !!?10,"2) PCC MASTER CONTROL file is defined for this site: ",$S(X:"YES",1:"NO")
  1.  ;
  1.  S X=$$GET1^DIQ(9001000,DUZ(2),.04) I X="" S STATUS=1
  1.  I TALK=2 W !!?10,"3) VISIT TYPE defined in the PCC MASTER CONTROL file: ",X
  1.  ;
  1.  S X=0,Y=0 F  S X=$O(^BDGPAR(X)) Q:'X  Q:Y  D
  1.  . ;I $D(^DG(40.8,"C",DUZ(2),X)) S Y=X  ;cmi/maw 9/1/09 orig line PATCH 1011
  1.  . I $D(^DG(40.8,"AD",DUZ(2),X)) S Y=X  ;cmi/maw 9/1/09 mod line PATCH 1011
  1.  I 'Y S STATUS=0
  1.  I TALK=2 W !?10,"4) ADT Division in IHS ADT PARAMETER file: ",$S('Y:"NO",1:$$GET1^DIQ(40.8,Y,.01))
  1.  ;
  1.  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")
  1.  I 'X S STATUS=0
  1.  ;
  1.  S Y=$S($D(^APCCCTRL(DUZ(2),11,+X,0)):"YES",1:"NO")
  1.  I Y="NO",STATUS S STATUS=1
  1.  I TALK=2 W !!?10,"6) PIMS entry exists in the PCC MASTER CONTROL file: ",Y
  1.  ;
  1.  I $D(^APCCCTRL(DUZ(2),11,+X,0)),STATUS D
  1.  . S Y=+$P(^APCCCTRL(DUZ(2),11,+X,0),U,2) I 'Y S STATUS=1
  1.  . I TALK=2 D
  1.  .. W !!?10,"7) PIMS entry has ""PASS DATA TO PCC"" set to: "
  1.  .. W $S(Y:"YES",1:"NO")
  1.  ;
  1.  I TALK D
  1.  . I STATUS=0 S X="** ADT is NOT set up properly; contact application coordinator. **"
  1.  . I STATUS=1 S X="** PCC link is turned OFF. **"
  1.  . I STATUS=2 S X="** PCC link is turned ON. **"
  1.  . I TALK=2 W !!?(80-$L(X)/2),X Q
  1.  . I STATUS=0 W !?(80-$L(X)/2),X I '$D(^XUSEC("DGZSYS",DUZ)) D PAUSE^BDGF S XQUIT=1 Q
  1.  . I STATUS,$D(^XUSEC("DGZSYS",DUZ)) W !?(80-$L(X)/2),X
  1.  ;
  1.  Q STATUS
  1.  ;
  1. EXIT ;PEP; kill system wide variables
  1.  K BDGMENU,BDGDIV,BDGQUIT
  1.  D EN^XBVK("VALM")
  1.  Q
  1.  ;
  1.  NEW BDG
  1.  S BDG("TITLE")=$P($G(XQY0),U,2)
  1.  I $L(BDG("TITLE"))>2 W @IOF,!!?80-$L(BDG("TITLE"))/2,BDG("TITLE")
  1.  S X=$$GET1^DIQ(4,DUZ(2),.01)
  1.  W !!?80-$L(X)\2,"(",X,")"
  1.  Q
  1.  ;
  1. SECENTER ;EP; entry point for Security Officer Menu
  1.  ;Part of PIMS but released with DPT so use DPT version #
  1.  ;
  1.  D ^XBCLS W !?18 F BDG("I")=1:1:41 W "*"
  1.  W !?18,"*        INDIAN HEALTH SERVICE          *"
  1.  W !?18,"*   SENSITIVE PATIENT TRACKING MODULE   *"
  1.  W !?18,"*             VERSION ",$$VERSION^XPDUTL("PIMS"),?58,"*"
  1.  W !?18 F BDG("I")=1:1:41 W "*"
  1.  ;
  1.  I '$D(DUZ(2))!('$D(DUZ(0))) D  D SECQUIT Q
  1.  .W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE THIS MENU"
  1.  .S XQUIT=1 D PAUSE^BDGF
  1.  S X=$$GET1^DIQ(4,DUZ(2),.01) W !!?80-$L(X)\2,X
  1.  I X="" W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!" S XQUIT=1
  1.  ;
  1. SECQUIT W ! K BDG,X,Y Q