- 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