PXRMP47I ;SLC/PKR - Inits for PXRM*2.0*47. ;05/18/2016
;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
Q
;==========================================
CFINC(Y) ;List of computed findings to include in the build.
N CFLIST,CFNAME
S CFLIST("VA-AGE BIRTH SEX LIST")=""
S CFLIST("VA-BIRTH DATE BIRTH SEX LIST")=""
S CFLIST("VA-FILEMAN DATE")=""
S CFNAME=$P($G(^PXRMD(811.4,Y,0)),U,1)
Q $S($D(CFLIST(CFNAME)):1,1:0)
;
;==========================================
DELDEFAD ;Delete file #811.9 field #.01 "AD" cross-reference.
N MSG
D DELIX^DDMOD(811.9,.01,2,"","","MSG")
Q
;
;==========================================
DELTAXDD ;Delete the taxonomy data dictionary.
N DIU
S DIU=811.2,DIU(0)="ET"
D EN^DIU2
Q
;
;==========================================
DELETAX ;Delete the expanded taxonomy file.
N DIU
S DIU=811.3,DIU(0)="DT"
D EN^DIU2
Q
;
;==========================================
DELVSDD ;Delete the value set files.
N DIU,FILENUM
F FILENUM=802.1,802.2,802.3 D
. S DIU=FILENUM,DIU(0)="DT"
. D EN^DIU2
Q
;
;==========================================
DELETEP() ;
N DA,DIK
S DIK="^PXRMD(801.45,",DA=$O(^PXRMD(801.45,"B","SNOMED","")) I +$G(DA)'>0 Q
D ^DIK
Q
;==========================================
PRE ;Pre-init
;Disable options and protocols
D OPTIONS^PXRMUTIL("DISABLE","Install of PXRM*2.0*47")
D PROTCOLS^PXRMUTIL("DISABLE","Install of PXRM*2.0*47")
D DELTAXDD^PXRMP47I
D DELVSDD^PXRMP47I
Q
;
;==========================================
POST ;Post-init
D DELETEP
D RMOBSFD^PXRMP47I
D RBLD20IA^PXRMTAXD
D VSINS^PXRMP47I
D UCDIA^PXRMP47I
D UCFREQ^PXRMP47I
D DELDEFAD^PXRMP47I
D DELETAX^PXRMP47I
;Enable options and protocols
D OPTIONS^PXRMUTIL("ENABLE","Install of PXRM*2.0*47")
D PROTCOLS^PXRMUTIL("ENABLE","Install of PXRM*2.0*47")
D SENDIM^PXRMMSG("PXRM*2.0*47")
Q
;
;==========================================
RMOBSFD ;Remove obsolete field data.
N IEN,NAME
D BMES^XPDUTL("Removing obsolete field data")
S NAME=""
F S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME="" D
. D MES^XPDUTL(" Working on taxonomy "_NAME)
. S IEN=""
. F S IEN=$O(^PXD(811.2,"B",NAME,IEN)) Q:IEN="" D
..;Brief Description
.. S $P(^PXD(811.2,IEN,0),U,2)=""
..;Dialog Header Text
.. S $P(^PXD(811.2,IEN,0),U,3)=""
..;ICD9 Range of Codes
.. K ^PXD(811.2,IEN,80)
..;ICD0 Range of Codes
.. K ^PXD(811.2,IEN,80.1)
..;CPT Range of Codes
.. K ^PXD(811.2,IEN,81)
..;Selectable Codes
.. K ^PXD(811.2,IEN,"SDX")
..;Selectable Procedures
.. K ^PXD(811.2,IEN,"SPR")
..;Dialog Parameters:
..;(#3106) GENERATE DIALOG DX PARAMETER [1S] ^ (#3107) CURRENT VISIT
..;DX DIALOG HDR [2F] ^ (#3108) HISTORICAL VISIT DX DIALOG HDR [3F] ^
.. K ^PXD(811.2,IEN,"SDZ")
..;(#3110) GENERATE DIALOG PR PARAMETER [1S] ^
..;(#3111) CURRENT VISIT PR DIALOG HDR [2F] ^ (#3112) HISTORICAL
..;VISIT PR DIALOG HDR [3F]
.. K ^PXD(811.2,IEN,"SPZ")
Q
;
;==========================================
UCDIA ;Change the DO IN ADVANCE TIME FRAME input transform so it will always
;be stored as upper case and make sure all existing entries are
;upper case.
N DIA,FDA,FREQ,IEN,IENS,IND,MSG,TEXT
D BMES^XPDUTL("Making sure all DO IN ADVANCE TIME FRAMEs are uppercase.")
S $P(^DD(811.9,1.3,0),U,6)="PXRMINTR(.X) X"
S IEN=0
F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
. S DIA=$P(^PXD(811.9,IEN,0),U,4)
. I DIA="" Q
. I DIA?1.N1L D
.. S TEXT(1)=""
.. S TEXT(2)="Found lower case DO IN ADVANCE TIME FRAME:"
.. S TEXT(3)=" IEN="_IEN_" DO IN ADVANCE="_DIA
.. S TEXT(4)=" Changing it to upper case."
.. D MES^XPDUTL(.TEXT)
.. S DIA=$$UP^XLFSTR(DIA)
.. S $P(^PXD(811.9,IEN,0),U,4)=DIA
Q
;
;==========================================
UCFREQ ;Change the reminder frequency input transform so they will always
;be stored as upper case and make sure all existing frequencies are
;upper case.
N FDA,FREQ,IEN,IENS,IND,MSG,TEXT
D BMES^XPDUTL("Making sure all reminder frequencies are uppercase.")
;Baseline
S $P(^DD(811.97,.01,0),U,6)="PXRMINTR(.X) X"
;Finding modifier
S $P(^DD(811.902,3,0),U,6)="PXRMINTR(.X) X"
S IEN=0
F S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0 D
.;Baseline
. S IND=0
. F S IND=+$O(^PXD(811.9,IEN,7,IND)) Q:IND=0 D
.. S FREQ=$P(^PXD(811.9,IEN,7,IND,0),U,1)
.. I FREQ?1.N1L D
... S TEXT(1)=""
... S TEXT(2)="Found lower case baseline frequency:"
... S TEXT(3)=" IEN="_IEN_" IND="_IND_" Frequency="_FREQ
... S TEXT(4)=" Changing it to upper case."
... D MES^XPDUTL(.TEXT)
... S FREQ=$$UP^XLFSTR(FREQ)
... S IENS=IND_","_IEN_","
... S FDA(811.97,IENS,.01)=FREQ
... D FILE^DIE("ET","FDA","MSG")
.;Findings
. S IND=0
. F S IND=+$O(^PXD(811.9,IEN,20,IND)) Q:IND=0 D
.. S FREQ=$P(^PXD(811.9,IEN,20,IND,0),U,4)
.. I FREQ?1.N1L D
... S TEXT(1)=""
... S TEXT(2)="Found lower case finding frequency:"
... S TEXT(3)=" IEN="_IEN_" Finding="_IND_" Frequency="_FREQ
... S TEXT(4)=" Changing it to upper case."
... D MES^XPDUTL(.TEXT)
... S FREQ=$$UP^XLFSTR(FREQ)
... S $P(^PXD(811.9,IEN,20,IND,0),U,4)=FREQ
Q
;
;==========================================
VSINS ;Install the value set file data.
N FILENUM
D BMES^XPDUTL("Installing Value Set data.")
F FILENUM=802.1,802.2,802.3 M ^PXRM(FILENUM)=@XPDGREF@(FILENUM)
Q
;
;==========================================
VSSAVE ;Pre-Transportation routine; save the value set file data in the
;transport global.
N FILENUM
F FILENUM=802.1,802.2,802.3 M @XPDGREF@(FILENUM)=^PXRM(FILENUM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP47I 5592 printed Apr 09, 2024@20:50:16 Page 2
PXRMP47I ;SLC/PKR - Inits for PXRM*2.0*47. ;05/18/2016
+1 ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
+2 QUIT
+3 ;==========================================
CFINC(Y) ;List of computed findings to include in the build.
+1 NEW CFLIST,CFNAME
+2 SET CFLIST("VA-AGE BIRTH SEX LIST")=""
+3 SET CFLIST("VA-BIRTH DATE BIRTH SEX LIST")=""
+4 SET CFLIST("VA-FILEMAN DATE")=""
+5 SET CFNAME=$PIECE($GET(^PXRMD(811.4,Y,0)),U,1)
+6 QUIT $SELECT($DATA(CFLIST(CFNAME)):1,1:0)
+7 ;
+8 ;==========================================
DELDEFAD ;Delete file #811.9 field #.01 "AD" cross-reference.
+1 NEW MSG
+2 DO DELIX^DDMOD(811.9,.01,2,"","","MSG")
+3 QUIT
+4 ;
+5 ;==========================================
DELTAXDD ;Delete the taxonomy data dictionary.
+1 NEW DIU
+2 SET DIU=811.2
SET DIU(0)="ET"
+3 DO EN^DIU2
+4 QUIT
+5 ;
+6 ;==========================================
DELETAX ;Delete the expanded taxonomy file.
+1 NEW DIU
+2 SET DIU=811.3
SET DIU(0)="DT"
+3 DO EN^DIU2
+4 QUIT
+5 ;
+6 ;==========================================
DELVSDD ;Delete the value set files.
+1 NEW DIU,FILENUM
+2 FOR FILENUM=802.1,802.2,802.3
Begin DoDot:1
+3 SET DIU=FILENUM
SET DIU(0)="DT"
+4 DO EN^DIU2
End DoDot:1
+5 QUIT
+6 ;
+7 ;==========================================
DELETEP() ;
+1 NEW DA,DIK
+2 SET DIK="^PXRMD(801.45,"
SET DA=$ORDER(^PXRMD(801.45,"B","SNOMED",""))
IF +$GET(DA)'>0
QUIT
+3 DO ^DIK
+4 QUIT
+5 ;==========================================
PRE ;Pre-init
+1 ;Disable options and protocols
+2 DO OPTIONS^PXRMUTIL("DISABLE","Install of PXRM*2.0*47")
+3 DO PROTCOLS^PXRMUTIL("DISABLE","Install of PXRM*2.0*47")
+4 DO DELTAXDD^PXRMP47I
+5 DO DELVSDD^PXRMP47I
+6 QUIT
+7 ;
+8 ;==========================================
POST ;Post-init
+1 DO DELETEP
+2 DO RMOBSFD^PXRMP47I
+3 DO RBLD20IA^PXRMTAXD
+4 DO VSINS^PXRMP47I
+5 DO UCDIA^PXRMP47I
+6 DO UCFREQ^PXRMP47I
+7 DO DELDEFAD^PXRMP47I
+8 DO DELETAX^PXRMP47I
+9 ;Enable options and protocols
+10 DO OPTIONS^PXRMUTIL("ENABLE","Install of PXRM*2.0*47")
+11 DO PROTCOLS^PXRMUTIL("ENABLE","Install of PXRM*2.0*47")
+12 DO SENDIM^PXRMMSG("PXRM*2.0*47")
+13 QUIT
+14 ;
+15 ;==========================================
RMOBSFD ;Remove obsolete field data.
+1 NEW IEN,NAME
+2 DO BMES^XPDUTL("Removing obsolete field data")
+3 SET NAME=""
+4 FOR
SET NAME=$ORDER(^PXD(811.2,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 DO MES^XPDUTL(" Working on taxonomy "_NAME)
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^PXD(811.2,"B",NAME,IEN))
if IEN=""
QUIT
Begin DoDot:2
+8 ;Brief Description
+9 SET $PIECE(^PXD(811.2,IEN,0),U,2)=""
+10 ;Dialog Header Text
+11 SET $PIECE(^PXD(811.2,IEN,0),U,3)=""
+12 ;ICD9 Range of Codes
+13 KILL ^PXD(811.2,IEN,80)
+14 ;ICD0 Range of Codes
+15 KILL ^PXD(811.2,IEN,80.1)
+16 ;CPT Range of Codes
+17 KILL ^PXD(811.2,IEN,81)
+18 ;Selectable Codes
+19 KILL ^PXD(811.2,IEN,"SDX")
+20 ;Selectable Procedures
+21 KILL ^PXD(811.2,IEN,"SPR")
+22 ;Dialog Parameters:
+23 ;(#3106) GENERATE DIALOG DX PARAMETER [1S] ^ (#3107) CURRENT VISIT
+24 ;DX DIALOG HDR [2F] ^ (#3108) HISTORICAL VISIT DX DIALOG HDR [3F] ^
+25 KILL ^PXD(811.2,IEN,"SDZ")
+26 ;(#3110) GENERATE DIALOG PR PARAMETER [1S] ^
+27 ;(#3111) CURRENT VISIT PR DIALOG HDR [2F] ^ (#3112) HISTORICAL
+28 ;VISIT PR DIALOG HDR [3F]
+29 KILL ^PXD(811.2,IEN,"SPZ")
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
+32 ;==========================================
UCDIA ;Change the DO IN ADVANCE TIME FRAME input transform so it will always
+1 ;be stored as upper case and make sure all existing entries are
+2 ;upper case.
+3 NEW DIA,FDA,FREQ,IEN,IENS,IND,MSG,TEXT
+4 DO BMES^XPDUTL("Making sure all DO IN ADVANCE TIME FRAMEs are uppercase.")
+5 SET $PIECE(^DD(811.9,1.3,0),U,6)="PXRMINTR(.X) X"
+6 SET IEN=0
+7 FOR
SET IEN=+$ORDER(^PXD(811.9,IEN))
if IEN=0
QUIT
Begin DoDot:1
+8 SET DIA=$PIECE(^PXD(811.9,IEN,0),U,4)
+9 IF DIA=""
QUIT
+10 IF DIA?1.N1L
Begin DoDot:2
+11 SET TEXT(1)=""
+12 SET TEXT(2)="Found lower case DO IN ADVANCE TIME FRAME:"
+13 SET TEXT(3)=" IEN="_IEN_" DO IN ADVANCE="_DIA
+14 SET TEXT(4)=" Changing it to upper case."
+15 DO MES^XPDUTL(.TEXT)
+16 SET DIA=$$UP^XLFSTR(DIA)
+17 SET $PIECE(^PXD(811.9,IEN,0),U,4)=DIA
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
+20 ;==========================================
UCFREQ ;Change the reminder frequency input transform so they will always
+1 ;be stored as upper case and make sure all existing frequencies are
+2 ;upper case.
+3 NEW FDA,FREQ,IEN,IENS,IND,MSG,TEXT
+4 DO BMES^XPDUTL("Making sure all reminder frequencies are uppercase.")
+5 ;Baseline
+6 SET $PIECE(^DD(811.97,.01,0),U,6)="PXRMINTR(.X) X"
+7 ;Finding modifier
+8 SET $PIECE(^DD(811.902,3,0),U,6)="PXRMINTR(.X) X"
+9 SET IEN=0
+10 FOR
SET IEN=+$ORDER(^PXD(811.9,IEN))
if IEN=0
QUIT
Begin DoDot:1
+11 ;Baseline
+12 SET IND=0
+13 FOR
SET IND=+$ORDER(^PXD(811.9,IEN,7,IND))
if IND=0
QUIT
Begin DoDot:2
+14 SET FREQ=$PIECE(^PXD(811.9,IEN,7,IND,0),U,1)
+15 IF FREQ?1.N1L
Begin DoDot:3
+16 SET TEXT(1)=""
+17 SET TEXT(2)="Found lower case baseline frequency:"
+18 SET TEXT(3)=" IEN="_IEN_" IND="_IND_" Frequency="_FREQ
+19 SET TEXT(4)=" Changing it to upper case."
+20 DO MES^XPDUTL(.TEXT)
+21 SET FREQ=$$UP^XLFSTR(FREQ)
+22 SET IENS=IND_","_IEN_","
+23 SET FDA(811.97,IENS,.01)=FREQ
+24 DO FILE^DIE("ET","FDA","MSG")
End DoDot:3
End DoDot:2
+25 ;Findings
+26 SET IND=0
+27 FOR
SET IND=+$ORDER(^PXD(811.9,IEN,20,IND))
if IND=0
QUIT
Begin DoDot:2
+28 SET FREQ=$PIECE(^PXD(811.9,IEN,20,IND,0),U,4)
+29 IF FREQ?1.N1L
Begin DoDot:3
+30 SET TEXT(1)=""
+31 SET TEXT(2)="Found lower case finding frequency:"
+32 SET TEXT(3)=" IEN="_IEN_" Finding="_IND_" Frequency="_FREQ
+33 SET TEXT(4)=" Changing it to upper case."
+34 DO MES^XPDUTL(.TEXT)
+35 SET FREQ=$$UP^XLFSTR(FREQ)
+36 SET $PIECE(^PXD(811.9,IEN,20,IND,0),U,4)=FREQ
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
+39 ;==========================================
VSINS ;Install the value set file data.
+1 NEW FILENUM
+2 DO BMES^XPDUTL("Installing Value Set data.")
+3 FOR FILENUM=802.1,802.2,802.3
MERGE ^PXRM(FILENUM)=@XPDGREF@(FILENUM)
+4 QUIT
+5 ;
+6 ;==========================================
VSSAVE ;Pre-Transportation routine; save the value set file data in the
+1 ;transport global.
+2 NEW FILENUM
+3 FOR FILENUM=802.1,802.2,802.3
MERGE @XPDGREF@(FILENUM)=^PXRM(FILENUM)
+4 QUIT
+5 ;
