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

BGOPOST.m

Go to the documentation of this file.
  1. BGOPOST ; IHS/BAO/TMD - BGO POST INIT ;29-May-2007 10:32;DKM
  1. ;;1.1;BGO COMPONENTS;**1,3**;Mar 20, 2007
  1. ;
  1. D REGNMSP^CIAURPC("BGO","CIAV VUECENTRIC")
  1. D PARAMS
  1. D MENUS
  1. D REFUSALS
  1. D FIXFCN("BI TODAY"),FIXFCN("BI NOW")
  1. D FIXPL
  1. D CLEANUP
  1. D XREF
  1. Q
  1. D REGMENU^BEHUTIL("BGOHF MAIN",,"HFA")
  1. D REGMENU^BEHUTIL("BGOIMM MAIN",,"IMM")
  1. D REGMENU^BEHUTIL("BGOPL MAIN",,"PLS")
  1. D REGMENU^BEHUTIL("BGOPOV MAIN",,"POV")
  1. D REGMENU^BEHUTIL("BGOPROC MAIN",,"PRC")
  1. D REGMENU^BEHUTIL("BGOPTED MAIN",,"EDU")
  1. D REGMENU^BEHUTIL("BGOPHHX MAIN",,"PHX")
  1. D REGMENU^BEHUTIL("BGOCC MAIN",,"CCX")
  1. Q:$$VERSION^XPDUTL("BEH UTILITIES")<1.2
  1. D REGMENU^BEHUTIL("BGO DISABLE VITALS EDITING",,"DVE","BEHOVM MAIN")
  1. Q
  1. REFUSALS N IEN,FDA,CNT,X,Y
  1. D BMES^XPDUTL("Searching for missing Refusal Items...")
  1. S (CNT,IEN)=0
  1. F S IEN=$O(^AUPNPREF(IEN)) Q:'IEN S X=$G(^(IEN,0)) D
  1. .Q:$P(X,U,4)'=""!($P(X,U,5)="")
  1. .S Y=$$VAL^XBDIQ1($P(X,U,5),$P(X,U,6),$P($G(^AUTTREFT($P(X,U),0)),U,3))
  1. .S:$L(Y) FDA(9000022,IEN_",",.04)=$E(Y,1,80),CNT=CNT+1
  1. D BMES^XPDUTL("Missing Refusal Items Found: "_CNT)
  1. D:$D(FDA) FILE^DIE(,"FDA")
  1. Q
  1. PARAMS Q:'$D(^BGOPARAM)
  1. N IEN,RET,FLG,X
  1. D BMES^XPDUTL("Migrating data from BGO PARAMETERS file...")
  1. S (IEN,FLG)=0
  1. F S IEN=$O(^BGOPARAM(IEN)) Q:'IEN D
  1. .S X=$P(^BGOPARAM(IEN,0),U,1,2),$P(X,U,3)="SYS"
  1. .D SETPARM^BGOUTL(.RET,X)
  1. .I RET D
  1. ..S FLG=1
  1. ..D BMES^XPDUTL(" Error migrating "_$P(X,U))
  1. .E D BMES^XPDUTL(" "_$P(X,U)_" migrated")
  1. D SETPARM^BGOUTL(,"Caption-Facility^"_$S(^XMB("NETNAME")["DOMAIN.NAME":"IHS/Tribal &Facility",1:"&Facility")_"^SYS")
  1. D:'FLG DELFIL^CIAVINIT(90362.04)
  1. Q
  1. FIXFCN(FCN) ;
  1. N FDA
  1. S FCN=$$FIND1^DIC(.5,,"X",FCN)
  1. Q:'FCN
  1. S FDA(.5,FCN_",",2)="X"
  1. D UPDATE^DIE(,"FDA")
  1. Q
  1. FIXPL N LP1,LP2
  1. S LP1=0
  1. F S LP1=$O(^BGOEDTPR(LP1)) Q:'LP1 D
  1. .N TMP,MGR,CNT
  1. .S (LP2,CNT)=0
  1. .M TMP=^BGOEDTPR(LP1,2)
  1. .K ^BGOEDTPR(LP1,2)
  1. .F S LP2=$O(TMP(LP2)) Q:'LP2 S MGR=+$G(TMP(LP2,0)) D:MGR
  1. ..S ^BGOEDTPR(LP1,2,MGR,0)=MGR,^BGOEDTPR(LP1,2,"B",MGR,MGR)=""
  1. ..S CNT=CNT+1,^BGOEDTPR(LP1,2,0)="^90362.362P^"_MGR_U_CNT
  1. Q
  1. XREF N DIK,DA
  1. D BMES^XPDUTL("Reindexing Files...")
  1. S DIK="^BGOCCPL(",DIK(1)=.02
  1. D ENALL^DIK
  1. S DIK="^AUTTEDT(",DIK(1)=1
  1. D ENALL^DIK
  1. Q
  1. CLEANUP D RENENTRY^BEHUTIL(19930.2,"PVATLCALENDAR.PVCALENDAR.1","@")
  1. D RENENTRY^BEHUTIL(19930.2,"PVDATE2.PVDATE2.1","@")
  1. D RENENTRY^BEHUTIL(19930.2,"FILE:PVNUM.OCX","@")
  1. Q