AG71A8 ;VNGT/HS/BEE - Patient Registration 7.1 PATCH 8 POST INSTALL ; MAY 07, 2010
;;7.1;PATIENT REGISTRATION;**8**;AUG 25, 2005
;
Q
;
POST ;EP - From KIDS.
;
N MMSG,IEN
D TS,BMES^XPDUTL("Beginning post-install routine (POST^AG71A8).")
;
S MMSG=" --- AG v 7.1 Patch 8 has been installed into this uci --- "
;
;Set new 'LINK AOB TO ROI FIELD' to default of 'NO'
;and define new facility parameter ROI/AOB required prompts
W !
S IEN=0 F S IEN=$O(^AGFAC(IEN)) Q:'IEN D
. ;
. ;Set up new AOB Required registration parameter prompt
. D AOB^AG71A8(IEN)
. ;
. ;Set up new ROI Required registration parameter prompt
. D ROI^AG71A8(IEN)
. ;
. N AGVAR,FLD,ERROR
. S FLD=$$GET1^DIQ(9009061,IEN_",","26","I") Q:FLD]""
. S AGVAR(9009061,IEN_",","26")="N"
. D FILE^DIE("","AGVAR","ERROR")
. I $D(ERROR) S MMSG=" --- AG v 7.1 Patch 8 Post Install Encountered Issues (37) --- "
;
;Convert Internet single WHERE field to new multiple field
D WEB
;
D TS,BMES^XPDUTL("Delivering v 7.1 Patch 8 install message to select users...")
;
;Deliver Mail Message
D MAIL(MMSG)
;
D TS,BMES^XPDUTL("AG v 7.1 Patch 8 Post-install is complete.")
Q
;
MAIL(MMSG) ;Send install mail message.
N %,CNT,DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
K ^TMP("AG71MS",$J)
S ^TMP("AG71MS",$J,1)=$G(MMSG)
S ^TMP("AG71MS",$J,2)=" "
S CNT=3
;
S %=0
Q:$G(XPDA)=""
Q:$G(XPDBLD)=""
F S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'% S ^TMP("AG71MS",$J,(%+CNT))=" "_^(%,0)
S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AG71MS"",$J,",XMY(1)="",XMY(DUZ)=""
F %="AGZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
K ^TMP("AG71MS",$J)
Q
SINGLE(K) ;EP - Get holders of a single key K.
N Y
S Y=0
Q:'$D(^XUSEC(K))
F S Y=$O(^XUSEC(K,Y)) Q:'Y S XMY(Y)=""
Q
;
TS D MES^XPDUTL($$HTE^XLFDT($H)) Q
;
AOB(FAC) ;Add ASSIGN BENEFITS OBTAINED DATE to facility required field list
;
N AOBIEN,DA,DIC,FLIEN,X,Y
;
;First Look for existing 9000001 entry
S DA(1)=FAC
S DIC="^AGFAC("_FAC_",11,"
S DIC(0)="L"
S X="9000001"
D ^DIC
Q:Y'>0
S FLIEN=+Y
;
;Quit if ASSIGN BENEFITS OBTAINED DATE already defined
I $O(^AGFAC(FAC,11,FLIEN,1,"B","ASSIGN BENEFITS OBTAINED DATE",""))]"" Q
;
;Now change the file to 9000001.71 so it can pass input transform check
K DA,DIC,X,Y
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001.71"
D ^DIE
;
;Now add the ASSIGN BENEFITS OBTAINED DATE
W !
K DA,DIE,DR
N DA,DIC,X,Y
S DA(2)=FAC,DA(1)=FLIEN
S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DIC(0)="LS"
S X=".01"
D ^DIC
S AOBIEN=+Y
I +AOBIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
;
;Set the required value to NO
K DA,DIC,X,Y
N DA,DIE,DR
S DA(2)=FAC,DA(1)=FLIEN,DA=AOBIEN
S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DR=".02////0"
D ^DIE
;
;Now change the file back to 9000001
K DA,DIE,DR
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001"
D ^DIE
;
Q
;
ROI(FAC) ;Add RELEASE OF INFORMATION to facility required field list
;
N ROIIEN,DA,DIC,FLIEN,X,Y
;
;First Look for existing 9000001 entry
S DA(1)=FAC
S DIC="^AGFAC("_FAC_",11,"
S DIC(0)="L"
S X="9000001"
D ^DIC
Q:Y'>0
S FLIEN=+Y
;
;Quit if RELEASE OF INFORMATION already defined
I $O(^AGFAC(FAC,11,FLIEN,1,"B","RELEASE OF INFORMATION",""))]"" Q
;
;Now change the file to 9000001.03601 so it can pass input transform check
K DA,DIC,X,Y
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001.03601"
D ^DIE
;
;Now add the RELEASE OF INFORMATION
W !
K DA,DIE,DR
N DA,DIC,X,Y
S DA(2)=FAC,DA(1)=FLIEN
S DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DIC(0)="LS"
S X=".01"
D ^DIC
S ROIIEN=+Y
I +ROIIEN W " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
;
;Set the required value to NO
K DA,DIC,X,Y
N DA,DIE,DR
S DA(2)=FAC,DA(1)=FLIEN,DA=ROIIEN
S DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
S DR=".02////0"
D ^DIE
;
;Now change the file back to 9000001
K DA,DIE,DR
N DA,DIE,DR
S DA(1)=FAC,DA=FLIEN
S DIE="^AGFAC("_DA(1)_",11,"
S DR=".01////9000001"
D ^DIE
Q
;
WEB ;Copy Internet WHERE from single field to new multiple
;
N DFN,LDT,LIEN,WHERE,DIC,X,Y,DLAYGO
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
. ;
. ;Loop through each stored entry
. S LIEN=0 F S LIEN=$O(^AUPNPAT(DFN,81,LIEN)) Q:'LIEN D
.. I $D(^AUPNPAT(DFN,81,LIEN,1,0)) Q ;Already completed
.. ;
.. ;Pull current single WHERE value
.. S WHERE=$$GET1^DIQ(9000001.81,LIEN_","_DFN_",",.03,"I") Q:WHERE=""
.. ;
.. ;Define new entry and save
.. S DIC="^AUPNPAT("_DFN_",81,"_LIEN_",1,",DA(2)=DFN,DA(1)=LIEN
.. S DIC(0)="L"
.. S X=WHERE
.. S DLAYGO="9000001.811",DIC("P")=DLAYGO
.. I '$D(^AUPNPAT(DFN,81,LIEN,1,0)) S ^AUPNPAT(DFN,81,LIEN,1,0)="^9000001.811SA^^"
.. K DO,DD D FILE^DICN
;
Q
;
PRE ;EP - From KIDS
;
;Remove current - AG PATIENT REGISTRATION ERROR CODES entries
;(New File with data will be included in patch)
NEW DA,DIK
S DA=0,DIK="^AGEDERRS("
F S DA=$O(^AGEDERRS(DA)) Q:'DA D ^DIK
;
Q
AG71A8 ;VNGT/HS/BEE - Patient Registration 7.1 PATCH 8 POST INSTALL ; MAY 07, 2010
+1 ;;7.1;PATIENT REGISTRATION;**8**;AUG 25, 2005
+2 ;
+3 QUIT
+4 ;
POST ;EP - From KIDS.
+1 ;
+2 NEW MMSG,IEN
+3 DO TS
DO BMES^XPDUTL("Beginning post-install routine (POST^AG71A8).")
+4 ;
+5 SET MMSG=" --- AG v 7.1 Patch 8 has been installed into this uci --- "
+6 ;
+7 ;Set new 'LINK AOB TO ROI FIELD' to default of 'NO'
+8 ;and define new facility parameter ROI/AOB required prompts
+9 WRITE !
+10 SET IEN=0
FOR
SET IEN=$ORDER(^AGFAC(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+11 ;
+12 ;Set up new AOB Required registration parameter prompt
+13 DO AOB^AG71A8(IEN)
+14 ;
+15 ;Set up new ROI Required registration parameter prompt
+16 DO ROI^AG71A8(IEN)
+17 ;
+18 NEW AGVAR,FLD,ERROR
+19 SET FLD=$$GET1^DIQ(9009061,IEN_",","26","I")
IF FLD]""
QUIT
+20 SET AGVAR(9009061,IEN_",","26")="N"
+21 DO FILE^DIE("","AGVAR","ERROR")
+22 IF $DATA(ERROR)
SET MMSG=" --- AG v 7.1 Patch 8 Post Install Encountered Issues (37) --- "
End DoDot:1
+23 ;
+24 ;Convert Internet single WHERE field to new multiple field
+25 DO WEB
+26 ;
+27 DO TS
DO BMES^XPDUTL("Delivering v 7.1 Patch 8 install message to select users...")
+28 ;
+29 ;Deliver Mail Message
+30 DO MAIL(MMSG)
+31 ;
+32 DO TS
DO BMES^XPDUTL("AG v 7.1 Patch 8 Post-install is complete.")
+33 QUIT
+34 ;
MAIL(MMSG) ;Send install mail message.
+1 NEW %,CNT,DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+2 KILL ^TMP("AG71MS",$JOB)
+3 SET ^TMP("AG71MS",$JOB,1)=$GET(MMSG)
+4 SET ^TMP("AG71MS",$JOB,2)=" "
+5 SET CNT=3
+6 ;
+7 SET %=0
+8 IF $GET(XPDA)=""
QUIT
+9 IF $GET(XPDBLD)=""
QUIT
+10 FOR
SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))
IF '%
QUIT
SET ^TMP("AG71MS",$JOB,(%+CNT))=" "_^(%,0)
+11 SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
SET XMTEXT="^TMP(""AG71MS"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+12 FOR %="AGZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+13 DO ^XMD
+14 KILL ^TMP("AG71MS",$JOB)
+15 QUIT
SINGLE(K) ;EP - Get holders of a single key K.
+1 NEW Y
+2 SET Y=0
+3 IF '$DATA(^XUSEC(K))
QUIT
+4 FOR
SET Y=$ORDER(^XUSEC(K,Y))
IF 'Y
QUIT
SET XMY(Y)=""
+5 QUIT
+6 ;
TS DO MES^XPDUTL($$HTE^XLFDT($HOROLOG))
QUIT
+1 ;
AOB(FAC) ;Add ASSIGN BENEFITS OBTAINED DATE to facility required field list
+1 ;
+2 NEW AOBIEN,DA,DIC,FLIEN,X,Y
+3 ;
+4 ;First Look for existing 9000001 entry
+5 SET DA(1)=FAC
+6 SET DIC="^AGFAC("_FAC_",11,"
+7 SET DIC(0)="L"
+8 SET X="9000001"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET FLIEN=+Y
+12 ;
+13 ;Quit if ASSIGN BENEFITS OBTAINED DATE already defined
+14 IF $ORDER(^AGFAC(FAC,11,FLIEN,1,"B","ASSIGN BENEFITS OBTAINED DATE",""))]""
QUIT
+15 ;
+16 ;Now change the file to 9000001.71 so it can pass input transform check
+17 KILL DA,DIC,X,Y
+18 NEW DA,DIE,DR
+19 SET DA(1)=FAC
SET DA=FLIEN
+20 SET DIE="^AGFAC("_DA(1)_",11,"
+21 SET DR=".01////9000001.71"
+22 DO ^DIE
+23 ;
+24 ;Now add the ASSIGN BENEFITS OBTAINED DATE
+25 WRITE !
+26 KILL DA,DIE,DR
+27 NEW DA,DIC,X,Y
+28 SET DA(2)=FAC
SET DA(1)=FLIEN
+29 SET DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+30 SET DIC(0)="LS"
+31 SET X=".01"
+32 DO ^DIC
+33 SET AOBIEN=+Y
+34 IF +AOBIEN
WRITE " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
+35 ;
+36 ;Set the required value to NO
+37 KILL DA,DIC,X,Y
+38 NEW DA,DIE,DR
+39 SET DA(2)=FAC
SET DA(1)=FLIEN
SET DA=AOBIEN
+40 SET DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+41 SET DR=".02////0"
+42 DO ^DIE
+43 ;
+44 ;Now change the file back to 9000001
+45 KILL DA,DIE,DR
+46 NEW DA,DIE,DR
+47 SET DA(1)=FAC
SET DA=FLIEN
+48 SET DIE="^AGFAC("_DA(1)_",11,"
+49 SET DR=".01////9000001"
+50 DO ^DIE
+51 ;
+52 QUIT
+53 ;
ROI(FAC) ;Add RELEASE OF INFORMATION to facility required field list
+1 ;
+2 NEW ROIIEN,DA,DIC,FLIEN,X,Y
+3 ;
+4 ;First Look for existing 9000001 entry
+5 SET DA(1)=FAC
+6 SET DIC="^AGFAC("_FAC_",11,"
+7 SET DIC(0)="L"
+8 SET X="9000001"
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET FLIEN=+Y
+12 ;
+13 ;Quit if RELEASE OF INFORMATION already defined
+14 IF $ORDER(^AGFAC(FAC,11,FLIEN,1,"B","RELEASE OF INFORMATION",""))]""
QUIT
+15 ;
+16 ;Now change the file to 9000001.03601 so it can pass input transform check
+17 KILL DA,DIC,X,Y
+18 NEW DA,DIE,DR
+19 SET DA(1)=FAC
SET DA=FLIEN
+20 SET DIE="^AGFAC("_DA(1)_",11,"
+21 SET DR=".01////9000001.03601"
+22 DO ^DIE
+23 ;
+24 ;Now add the RELEASE OF INFORMATION
+25 WRITE !
+26 KILL DA,DIE,DR
+27 NEW DA,DIC,X,Y
+28 SET DA(2)=FAC
SET DA(1)=FLIEN
+29 SET DIC="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+30 SET DIC(0)="LS"
+31 SET X=".01"
+32 DO ^DIC
+33 SET ROIIEN=+Y
+34 IF +ROIIEN
WRITE " REQUIRED? parameter added for site: ",$$GET1^DIQ(9999999.06,FAC_",",.01,"E")
+35 ;
+36 ;Set the required value to NO
+37 KILL DA,DIC,X,Y
+38 NEW DA,DIE,DR
+39 SET DA(2)=FAC
SET DA(1)=FLIEN
SET DA=ROIIEN
+40 SET DIE="^AGFAC("_DA(2)_",11,"_DA(1)_",1,"
+41 SET DR=".02////0"
+42 DO ^DIE
+43 ;
+44 ;Now change the file back to 9000001
+45 KILL DA,DIE,DR
+46 NEW DA,DIE,DR
+47 SET DA(1)=FAC
SET DA=FLIEN
+48 SET DIE="^AGFAC("_DA(1)_",11,"
+49 SET DR=".01////9000001"
+50 DO ^DIE
+51 QUIT
+52 ;
WEB ;Copy Internet WHERE from single field to new multiple
+1 ;
+2 NEW DFN,LDT,LIEN,WHERE,DIC,X,Y,DLAYGO
+3 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+4 ;
+5 ;Loop through each stored entry
+6 SET LIEN=0
FOR
SET LIEN=$ORDER(^AUPNPAT(DFN,81,LIEN))
IF 'LIEN
QUIT
Begin DoDot:2
+7 ;Already completed
IF $DATA(^AUPNPAT(DFN,81,LIEN,1,0))
QUIT
+8 ;
+9 ;Pull current single WHERE value
+10 SET WHERE=$$GET1^DIQ(9000001.81,LIEN_","_DFN_",",.03,"I")
IF WHERE=""
QUIT
+11 ;
+12 ;Define new entry and save
+13 SET DIC="^AUPNPAT("_DFN_",81,"_LIEN_",1,"
SET DA(2)=DFN
SET DA(1)=LIEN
+14 SET DIC(0)="L"
+15 SET X=WHERE
+16 SET DLAYGO="9000001.811"
SET DIC("P")=DLAYGO
+17 IF '$DATA(^AUPNPAT(DFN,81,LIEN,1,0))
SET ^AUPNPAT(DFN,81,LIEN,1,0)="^9000001.811SA^^"
+18 KILL DO,DD
DO FILE^DICN
End DoDot:2
End DoDot:1
+19 ;
+20 QUIT
+21 ;
PRE ;EP - From KIDS
+1 ;
+2 ;Remove current - AG PATIENT REGISTRATION ERROR CODES entries
+3 ;(New File with data will be included in patch)
+4 NEW DA,DIK
+5 SET DA=0
SET DIK="^AGEDERRS("
+6 FOR
SET DA=$ORDER(^AGEDERRS(DA))
IF 'DA
QUIT
DO ^DIK
+7 ;
+8 QUIT
