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