BDGP1001 ;NEW PROGRAM [ 01/06/2005 11:38 AM ]
;;5.3;PIMS;**1001**;APR 26, 2002
;
POST ;
W !,"** CHECKING ENVIRONMENT **",!!
NEW VER,X
S VER=$$VERSION^XPDUTL("PIMS")
I VER'=5.3 D
. W !,"You must first install PIMS 5.3"
. I VER["t"!(VER["T") W !,"Your site may have a 'T' version loaded"
. S XPDQUIT=2
E D
.D UPDTVER ;Updates the two DPT version nodes
.D BSDXREF ;Ensures that the xref AIHSDAM is/was created
.D ADDPROT ;Ensures that ALL 14 protocols are included
Q
;
BSDXREF ;Assures that the AIHSDAM xref is/was created in ^SC (file#44)
; Some inpatient sites may not have had this xref created during
; the initial install of PIMS 5.3
D AIHSDAM^BSDPOST ;no check performed in BSDPOST prior to running
Q
UPDTVER ;Update the appropriate 'version' nodes for DPT.
;Using 'DPT' & the "C" Xref (PREFIX) should give you more than one
; entry, thus the reason for the $O. The two entries are:
; REGISTRATION^DG^ADT and PATIENT FILE^DPT^FILE 2
I $G(VER)]"" D
.S BDGN=0
.F S BDGN=$O(^DIC(9.4,"C","DPT",BDGN)) Q:'BDGN D
..S ^DIC(9.4,BDGN,"VERSION")=VER ;update current version field
..;
..; now add version multiple
..I '$O(^DIC(9.4,BDGN,22,"B",5.3,0)) D
...S DIC="^DIC(9.4,"_BDGN_",22,",DIC(0)="L",X=5.3
...S DIC("P")=$P(^DD(9.4,22,0),U,2)
...S DIC("DR")="2///"_DT_";3///`"_DUZ,DA(1)=BDGN
...D ^DIC
Q
;
ADDPROT ;This sub-rtn was MOSTLY copied from the original code. The change
; that was made was in the 'F BDGI=1:1:14' it was 1:1:13.
NEW IEN,ITEM,BDGE
S BDGE=$O(^ORD(101,"B","BDGPM MOVEMENT EVENTS",0)) I 'BDGE Q
;
F BDGI=1:1:14 S ITEM=$P($T(PROT+BDGI),";;",2) D
. I $D(^ORD(101,"B",ITEM)) D ;if protocol exists
.. S IEN=$O(^ORD(101,"B",ITEM,0)) Q:'IEN
.. Q:$D(^ORD(101,BDGE,10,"B",IEN)) ;already added to event driver
.. ;
.. ; go ahead and add it
.. S DIC="^ORD(101,"_BDGE_",10,",DIC(0)="L",DLAYGO=101.01
.. S DA(1)=BDGE,DIC("P")="101.01PA",X=IEN
.. S DIC("DR")="3///"_$P($T(PROT+BDGI),";;",3)
.. K DD,DO D FILE^DICN
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
PROT ;; Protocols to add to event driver
;;ORU PATIENT MOVMT;;101;;
;;ORU AUTOLIST;;105;;
;;PSJ OR PAT ADT;;120;;
;;GMRADGPM MARK CHART;;210;;
;;AQAL ADT EVENT;;150;;
;;FHWMAS;;160;;
;;SR IHS EVENT-ADMIT;;170;;
;;MAGD DHCP-PACS ADT EVENTS;;180;;
;;VEFSP PYXIS;;140;;
;;AMCO ADT EVENT;;130;;
;;BHL ADMIT A PATIENT;;5;;
;;BHL TRANSFER A PATIENT;;6;;
;;BHL DISCHARGE A PATIENT;;7;;
;;BHL PYXIS ADT;;141;;
BDGP1001 ;NEW PROGRAM [ 01/06/2005 11:38 AM ]
+1 ;;5.3;PIMS;**1001**;APR 26, 2002
+2 ;
POST ;
+1 WRITE !,"** CHECKING ENVIRONMENT **",!!
+2 NEW VER,X
+3 SET VER=$$VERSION^XPDUTL("PIMS")
+4 IF VER'=5.3
Begin DoDot:1
+5 WRITE !,"You must first install PIMS 5.3"
+6 IF VER["t"!(VER["T")
WRITE !,"Your site may have a 'T' version loaded"
+7 SET XPDQUIT=2
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 ;Updates the two DPT version nodes
DO UPDTVER
+10 ;Ensures that the xref AIHSDAM is/was created
DO BSDXREF
+11 ;Ensures that ALL 14 protocols are included
DO ADDPROT
End DoDot:1
+12 QUIT
+13 ;
BSDXREF ;Assures that the AIHSDAM xref is/was created in ^SC (file#44)
+1 ; Some inpatient sites may not have had this xref created during
+2 ; the initial install of PIMS 5.3
+3 ;no check performed in BSDPOST prior to running
DO AIHSDAM^BSDPOST
+4 QUIT
UPDTVER ;Update the appropriate 'version' nodes for DPT.
+1 ;Using 'DPT' & the "C" Xref (PREFIX) should give you more than one
+2 ; entry, thus the reason for the $O. The two entries are:
+3 ; REGISTRATION^DG^ADT and PATIENT FILE^DPT^FILE 2
+4 IF $GET(VER)]""
Begin DoDot:1
+5 SET BDGN=0
+6 FOR
SET BDGN=$ORDER(^DIC(9.4,"C","DPT",BDGN))
IF 'BDGN
QUIT
Begin DoDot:2
+7 ;update current version field
SET ^DIC(9.4,BDGN,"VERSION")=VER
+8 ;
+9 ; now add version multiple
+10 IF '$ORDER(^DIC(9.4,BDGN,22,"B",5.3,0))
Begin DoDot:3
+11 SET DIC="^DIC(9.4,"_BDGN_",22,"
SET DIC(0)="L"
SET X=5.3
+12 SET DIC("P")=$PIECE(^DD(9.4,22,0),U,2)
+13 SET DIC("DR")="2///"_DT_";3///`"_DUZ
SET DA(1)=BDGN
+14 DO ^DIC
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
ADDPROT ;This sub-rtn was MOSTLY copied from the original code. The change
+1 ; that was made was in the 'F BDGI=1:1:14' it was 1:1:13.
+2 NEW IEN,ITEM,BDGE
+3 SET BDGE=$ORDER(^ORD(101,"B","BDGPM MOVEMENT EVENTS",0))
IF 'BDGE
QUIT
+4 ;
+5 FOR BDGI=1:1:14
SET ITEM=$PIECE($TEXT(PROT+BDGI),";;",2)
Begin DoDot:1
+6 ;if protocol exists
IF $DATA(^ORD(101,"B",ITEM))
Begin DoDot:2
+7 SET IEN=$ORDER(^ORD(101,"B",ITEM,0))
IF 'IEN
QUIT
+8 ;already added to event driver
IF $DATA(^ORD(101,BDGE,10,"B",IEN))
QUIT
+9 ;
+10 ; go ahead and add it
+11 SET DIC="^ORD(101,"_BDGE_",10,"
SET DIC(0)="L"
SET DLAYGO=101.01
+12 SET DA(1)=BDGE
SET DIC("P")="101.01PA"
SET X=IEN
+13 SET DIC("DR")="3///"_$PIECE($TEXT(PROT+BDGI),";;",3)
+14 KILL DD,DO
DO FILE^DICN
End DoDot:2
End DoDot:1
+15 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+16 QUIT
PROT ;; Protocols to add to event driver
+1 ;;ORU PATIENT MOVMT;;101;;
+2 ;;ORU AUTOLIST;;105;;
+3 ;;PSJ OR PAT ADT;;120;;
+4 ;;GMRADGPM MARK CHART;;210;;
+5 ;;AQAL ADT EVENT;;150;;
+6 ;;FHWMAS;;160;;
+7 ;;SR IHS EVENT-ADMIT;;170;;
+8 ;;MAGD DHCP-PACS ADT EVENTS;;180;;
+9 ;;VEFSP PYXIS;;140;;
+10 ;;AMCO ADT EVENT;;130;;
+11 ;;BHL ADMIT A PATIENT;;5;;
+12 ;;BHL TRANSFER A PATIENT;;6;;
+13 ;;BHL DISCHARGE A PATIENT;;7;;
+14 ;;BHL PYXIS ADT;;141;;
