Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGP1003

BDGP1003.m

Go to the documentation of this file.
  1. BDGP1003 ;IHS/ITSC/LJF - PRE & POST INSTALL, ENVIRON CHECK FOR PATCH 1003
  1. ;;5.3;PIMS;**1003**;MAY 28, 2004
  1. ;
  1. CKENV ; environment check code
  1. ;Prevents "Disable Options..." and "Move Routines..." questions
  1. S XPDDIQ("XPZ1")=0,XPPDIQ("XPZ2")=0
  1. ;
  1. ; now check for patch 1002
  1. S PATCH="PIMS*5.3*1002"
  1. I '$$PATCH(PATCH) D
  1. . W !,"You must first install "_PATCH_"." S XPDQUIT=2
  1. Q
  1. PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
  1. ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numbers
  1. Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
  1. NEW NUM,I,J
  1. S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
  1. S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
  1. ;check if patch is just a number
  1. Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
  1. S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
  1. Q (X=+NUM)
  1. ;
  1. PRE ;EP;
  1. CLEAN ; clean out ADT ITEM file before restoring data
  1. NEW X
  1. S X=0 F S X=$O(^BDGITM(X)) Q:'X K ^BDGITM(X)
  1. K ^BDGITM("B")
  1. S $P(^BDGITM(0),U,3,4)="0^0"
  1. Q
  1. ;
  1. POST ;EP; post install code
  1. D STUFF,KILLID,CDEF,PATCHES,FORM,DSFIX,BULL
  1. Q
  1. ;
  1. STUFF ; stuff new "Print A Sheet at Admission" parameter to 1
  1. ; and reset days to delinquency if greater than 30
  1. D BMES^XPDUTL("Initializing new ADT parameters . . .")
  1. NEW DA,DIE,DR
  1. S DA=0 F S DA=$O(^BDGPAR(DA)) Q:'DA D
  1. . I $$GET1^DIQ(9009020.1,DA,.16)="" D
  1. . . S DIE="^BDGPAR(",DR=".16///1" D ^DIE
  1. . I $$GET1^DIQ(9009020.1,DA,.12)>30 D
  1. . . S DIE="^BDGPAR(",DR=".12///30" D ^DIE
  1. Q
  1. ;
  1. KILLID ; remove VA identifier from file 45.7
  1. D BMES^XPDUTL("Removing VA identifier from file 45.7 . . .")
  1. K ^DD(45.7,0,"ID",1) ;Exemption from SAC #2.2.3.2.7 pending
  1. Q
  1. ;
  1. CDEF ; mark awaiting transcription entries under Admin grouping
  1. D BMES^XPDUTL("Marking ""AWAITING TRANS"" deficiencies to ADMIN group . . .")
  1. NEW BDGI,DA,DIE,DR
  1. S DIE="^BDGCD(",DR=".03///ADM"
  1. F BDGI="AWAITING TRANS NS","AWAITING TRANS OR" D
  1. . S DA=$O(^BDGCD("B",BDGI,0)) Q:'DA
  1. . D ^DIE
  1. Q
  1. ;
  1. FORM ; update line 4 in ADT FORM - IHS format
  1. D BMES^XPDUTL("Updating line 4 in IHS Clinical Record Brief format . . .")
  1. NEW DIE,DA,DR
  1. S DIE="^BDGFRM(1,""LINE"",4,""ITEM""," S DA(2)=1,DA(1)=4
  1. S DA=$O(^BDGFRM(1,"LINE",4,"ITEM","B",15,0))
  1. I DA S DR=".03///Community Code;.04///20" D ^DIE
  1. S DA=$O(^BDGFRM(1,"LINE",4,"ITEM","B",23,0))
  1. I DA S DR=".03///Admtg Ward;.04///15" D ^DIE
  1. S DA=$O(^BDGFRM(1,"LINE",4,"ITEM","B",22,0))
  1. I DA S DR=".03///Admtg Provider;.04///25" D ^DIE
  1. Q
  1. ;
  1. DSFIX ; find and fix any old day surgery entries without zero nodes
  1. D BMES^XPDUTL("Fixing any day surgery entries with errors . . .")
  1. NEW IEN S IEN=0
  1. F S IEN=$O(^ADGDS(IEN)) Q:'IEN I '$D(^ADGDS(IEN,0)) D
  1. . S ^ADGDS(IEN,0)=IEN,^ADGDS("B",IEN,IEN)=""
  1. . W !?5,"Entry for patient #",$$HRCN^BDGF2(IEN,DUZ(2))," fixed."
  1. Q
  1. ;
  1. BULL ; send bulletins to appropriate users
  1. D BMES^XPDUTL("Sending bulletins to users . . .")
  1. NEW XMB,USER,XMDT,XMY
  1. S XMB="BDG PATCH 1003",XMDT=$$NOW^XLFDT
  1. S USER=0 F S USER=$O(^XUSEC("DGZSYS",USER)) Q:'USER S XMY(USER)=""
  1. D ^XMB
  1. ;
  1. S XMB="BSD PATCH 1003",XMDT=$$NOW^XLFDT
  1. K XMY S USER=0 F S USER=$O(^XUSEC("SDZAC",USER)) Q:'USER S XMY(USER)=""
  1. D ^XMB
  1. Q
  1. ;
  1. PATCHES ; mark package file entry with old PIMS patch #s required by CSV
  1. D BMES^XPDUTL("Adding VA patch #s to patch history . . .")
  1. NEW PKG,VER,COUNT,PATCH,DA,DIC,X,Y
  1. F NMSP="DG","SD" D
  1. . S PKG=$O(^DIC(9.4,"C",NMSP,0)) Q:'PKG D
  1. . . S VER=$O(^DIC(9.4,PKG,22,"B","5.3",0)) Q:VER<1
  1. . . F COUNT=1:1 S PATCH=$P($T(OLDPATCH+COUNT),";;",2) Q:PATCH="" D
  1. . . . Q:$P($T(OLDPATCH+COUNT),";;",3)'=NMSP ;check namespace
  1. . . . I $D(^DIC(9.4,PKG,22,VER,"PAH","B",PATCH)) Q ;already in file
  1. . . . S DIC="^DIC(9.4,"_PKG_",22,"_VER_",""PAH"","
  1. . . . S DA(2)=PKG,DA(1)=VER,DIC(0)="L"
  1. . . . S DIC("P")=$P(^DD(9.49,1105,0),U,2)
  1. . . . S X=PATCH,DIC("DR")=".02///"_DT_";.03///`"_DUZ
  1. . . . D ^DIC
  1. Q
  1. ;
  1. OLDPATCH ;;
  1. ;;158 SEQ #0;;DG
  1. ;;190 SEQ #0;;DG
  1. ;;309 SEQ #0;;DG
  1. ;;397 SEQ #364;;DG
  1. ;;441 SEQ #386;;DG
  1. ;;418 SEQ #416;;DG
  1. ;;493 SEQ #430;;DG
  1. ;;512 SEQ #447;;DG
  1. ;;199 SEQ #220;;SD
  1. ;;258 SEQ #245;;SD
  1. ;;254 SEQ #247;;SD
  1. ;;296 SEQ #259;;SD