PXRMP11I ; SLC/PKR - Inits for PXRM*2.0*11 ;09/15/2008
;;2.0;CLINICAL REMINDERS;**11**;Feb 04, 2005;Build 39
Q
;====================================================
CFINC(Y) ;List of computed findings to include in the build.
N CFLIST,CFNAME
S CFLIST("VA-AGENT ORANGE EXPOSURE")=""
S CFLIST("VA-COMBAT SERVICE")=""
S CFLIST("VA-COMBAT VET ELIGIBILITY")=""
S CFLIST("VA-OEF SERVICE")=""
S CFLIST("VA-OIF SERVICE")=""
S CFLIST("VA-LAST SERVICE SEPARATION DATE")=""
S CFLIST("VA-POW")=""
S CFLIST("VA-PURPLE HEART")=""
S CFLIST("VA-SERVICE BRANCH")=""
S CFLIST("VA-UNKNOWN OEF/OIF SERVICE")=""
S CFLIST("VA-VETERAN")=""
S CFNAME=$P(^PXRMD(811.4,Y,0),U,1)
Q $S($D(CFLIST(CFNAME)):1,1:0)
;
;====================================================
DELDD ;Delete the old data dictionaries.
N DIU,TEXT
D EN^DDIOL("Removing old data dictionaries.")
S DIU(0)=""
F DIU=810.9 D
. S TEXT=" Deleting data dictionary for file # "_DIU
. D EN^DDIOL(TEXT)
. D EN^DIU2
Q
;
;====================================================
DRADCF ;Delete the radiation exposure computed finding entry from
;test sites.
N DA,DIK
S DA=+$O(PXD(811.4,"B","VA-RADIATION EXPOSURE",""))
I DA=0 Q
S DIK="^PXD(811.4,"
D ^DIK
Q
;
;====================================================
DTOITEMS ;Delete the transport only items.
N IEN,TEXT
S IEN=+$O(^PXD(811.9,"B","PATCH 11 ITEMS",""))
I IEN>0 D
. S TEXT="Removing PATCH 11 ITEMS transport reminder."
. D MES^XPDUTL(.TEXT)
. D DELETE^PXRMEXFI(811.9,IEN)
S IEN=+$O(^PXRMD(801.41,"B","PATCH 11 DIALOG",""))
I IEN>0 D
. S TEXT="Removing PATCH 11 DIALOG transport dialog."
. D MES^XPDUTL(.TEXT)
. D DELETE^PXRMEXFI(801.41,IEN)
Q
;
;====================================================
FFFIX ;Rebuild all function finding internal data structures to correct
;possible pointer errors.
N DA,IEN,X
D BMES^XPDUTL("Rebuilding Function Finding internal data structures.")
S IEN=0
F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
. I '$D(^PXD(811.9,IEN,25)) Q
. S DA(1)=IEN,DA=0
. F S DA=+$O(^PXD(811.9,IEN,25,DA)) Q:DA=0 D
.. S X=$G(^PXD(811.9,IEN,25,DA,3))
.. D FFKILL^PXRMFFDB(X,.DA)
.. D FFBUILD^PXRMFFDB(X,.DA)
Q
;
;====================================================
INILOCS ;Initialize the new field EXCL LOCS WITH NO CREDIT STOP.
N IND,JND
S IND=0
F S IND=+$O(^PXRMD(810.9,IND)) Q:IND=0 D
. S JND=0
. F S JND=+$O(^PXRMD(810.9,IND,40.7,JND)) Q:JND=0 S ^PXRMD(810.9,IND,40.7,JND,3)=""
Q
;
;====================================================
PRE ;These are the pre-installation actions
;Disable options and protocols
D OPTION^PXRMUTIL("DISABLE")
D PROTOCOL^PXRMUTIL("DISABLE")
;Delete existing exchange file entries.
D DELEXI^PXRMP11E
;Delete the old DDs.
D DELDD
Q
;
;====================================================
POST ;These are the post-installation actions
D FFFIX^PXRMP11I
;Enable options and protocols
D OPTION^PXRMUTIL("ENABLE")
D PROTOCOL^PXRMUTIL("ENABLE")
D SMEXINS^PXRMP11E
D DTOITEMS
D DRADCF
D INILOCS
D UPDDIAL
Q
;
;====================================================
UPDDIAL ;Update Element VA-MH PCLM with the correct dialog text
N DIEN
S DIEN=$O(^PXRMD(801.41,"B","VA-MH PCLM","")) Q:DIEN'>0
S ^PXRMD(801.41,DIEN,25,1,0)="PCL-M"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP11I 3368 printed Apr 09, 2024@20:52:47 Page 2
PXRMP11I ; SLC/PKR - Inits for PXRM*2.0*11 ;09/15/2008
+1 ;;2.0;CLINICAL REMINDERS;**11**;Feb 04, 2005;Build 39
+2 QUIT
+3 ;====================================================
CFINC(Y) ;List of computed findings to include in the build.
+1 NEW CFLIST,CFNAME
+2 SET CFLIST("VA-AGENT ORANGE EXPOSURE")=""
+3 SET CFLIST("VA-COMBAT SERVICE")=""
+4 SET CFLIST("VA-COMBAT VET ELIGIBILITY")=""
+5 SET CFLIST("VA-OEF SERVICE")=""
+6 SET CFLIST("VA-OIF SERVICE")=""
+7 SET CFLIST("VA-LAST SERVICE SEPARATION DATE")=""
+8 SET CFLIST("VA-POW")=""
+9 SET CFLIST("VA-PURPLE HEART")=""
+10 SET CFLIST("VA-SERVICE BRANCH")=""
+11 SET CFLIST("VA-UNKNOWN OEF/OIF SERVICE")=""
+12 SET CFLIST("VA-VETERAN")=""
+13 SET CFNAME=$PIECE(^PXRMD(811.4,Y,0),U,1)
+14 QUIT $SELECT($DATA(CFLIST(CFNAME)):1,1:0)
+15 ;
+16 ;====================================================
DELDD ;Delete the old data dictionaries.
+1 NEW DIU,TEXT
+2 DO EN^DDIOL("Removing old data dictionaries.")
+3 SET DIU(0)=""
+4 FOR DIU=810.9
Begin DoDot:1
+5 SET TEXT=" Deleting data dictionary for file # "_DIU
+6 DO EN^DDIOL(TEXT)
+7 DO EN^DIU2
End DoDot:1
+8 QUIT
+9 ;
+10 ;====================================================
DRADCF ;Delete the radiation exposure computed finding entry from
+1 ;test sites.
+2 NEW DA,DIK
+3 SET DA=+$ORDER(PXD(811.4,"B","VA-RADIATION EXPOSURE",""))
+4 IF DA=0
QUIT
+5 SET DIK="^PXD(811.4,"
+6 DO ^DIK
+7 QUIT
+8 ;
+9 ;====================================================
DTOITEMS ;Delete the transport only items.
+1 NEW IEN,TEXT
+2 SET IEN=+$ORDER(^PXD(811.9,"B","PATCH 11 ITEMS",""))
+3 IF IEN>0
Begin DoDot:1
+4 SET TEXT="Removing PATCH 11 ITEMS transport reminder."
+5 DO MES^XPDUTL(.TEXT)
+6 DO DELETE^PXRMEXFI(811.9,IEN)
End DoDot:1
+7 SET IEN=+$ORDER(^PXRMD(801.41,"B","PATCH 11 DIALOG",""))
+8 IF IEN>0
Begin DoDot:1
+9 SET TEXT="Removing PATCH 11 DIALOG transport dialog."
+10 DO MES^XPDUTL(.TEXT)
+11 DO DELETE^PXRMEXFI(801.41,IEN)
End DoDot:1
+12 QUIT
+13 ;
+14 ;====================================================
FFFIX ;Rebuild all function finding internal data structures to correct
+1 ;possible pointer errors.
+2 NEW DA,IEN,X
+3 DO BMES^XPDUTL("Rebuilding Function Finding internal data structures.")
+4 SET IEN=0
+5 FOR
SET IEN=+$ORDER(^PXD(811.9,IEN))
if IEN=0
QUIT
Begin DoDot:1
+6 IF '$DATA(^PXD(811.9,IEN,25))
QUIT
+7 SET DA(1)=IEN
SET DA=0
+8 FOR
SET DA=+$ORDER(^PXD(811.9,IEN,25,DA))
if DA=0
QUIT
Begin DoDot:2
+9 SET X=$GET(^PXD(811.9,IEN,25,DA,3))
+10 DO FFKILL^PXRMFFDB(X,.DA)
+11 DO FFBUILD^PXRMFFDB(X,.DA)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;====================================================
INILOCS ;Initialize the new field EXCL LOCS WITH NO CREDIT STOP.
+1 NEW IND,JND
+2 SET IND=0
+3 FOR
SET IND=+$ORDER(^PXRMD(810.9,IND))
if IND=0
QUIT
Begin DoDot:1
+4 SET JND=0
+5 FOR
SET JND=+$ORDER(^PXRMD(810.9,IND,40.7,JND))
if JND=0
QUIT
SET ^PXRMD(810.9,IND,40.7,JND,3)=""
End DoDot:1
+6 QUIT
+7 ;
+8 ;====================================================
PRE ;These are the pre-installation actions
+1 ;Disable options and protocols
+2 DO OPTION^PXRMUTIL("DISABLE")
+3 DO PROTOCOL^PXRMUTIL("DISABLE")
+4 ;Delete existing exchange file entries.
+5 DO DELEXI^PXRMP11E
+6 ;Delete the old DDs.
+7 DO DELDD
+8 QUIT
+9 ;
+10 ;====================================================
POST ;These are the post-installation actions
+1 DO FFFIX^PXRMP11I
+2 ;Enable options and protocols
+3 DO OPTION^PXRMUTIL("ENABLE")
+4 DO PROTOCOL^PXRMUTIL("ENABLE")
+5 DO SMEXINS^PXRMP11E
+6 DO DTOITEMS
+7 DO DRADCF
+8 DO INILOCS
+9 DO UPDDIAL
+10 QUIT
+11 ;
+12 ;====================================================
UPDDIAL ;Update Element VA-MH PCLM with the correct dialog text
+1 NEW DIEN
+2 SET DIEN=$ORDER(^PXRMD(801.41,"B","VA-MH PCLM",""))
if DIEN'>0
QUIT
+3 SET ^PXRMD(801.41,DIEN,25,1,0)="PCL-M"
+4 QUIT
+5 ;
