GMRC110P ;ABV/PIJ - Consult STA3N fix. Patch GMRC*3.0*110 ;8/1/18 07:36
;;3.0;CONSULT/REQUEST TRACKING;**110**;DEC 27, 1997;Build 6
;
;This routine locates a site's STA3N ID and places it in a GMRC UNIQUE CONSULT ID parameter.
;It is used by Community Care.
;
Q
;
POST ;updates GMRC UNIQUE CONSULT ID paramater file #8989.5
N GMRCID
;
S GMRCID=$E($P($$SITE^VASITE(),U,3),1,3)
I GMRCID="" D Q
.D BMES^XPDUTL()
.D MES^XPDUTL("*****************************************")
.D MES^XPDUTL("Your SITE ID does not exist.")
.D MES^XPDUTL("Please contact IRM for assistance.")
.D MES^XPDUTL("*****************************************")
;
D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC UNIQUE CONSULT SITE ID",,GMRCID)
;
D BMES^XPDUTL()
D MES^XPDUTL("******************************************************")
D MES^XPDUTL("Your STATION 3N (STA3N) is "_GMRCID_" and")
D MES^XPDUTL("has been recorded in the Parameters file.")
D MES^XPDUTL("******************************************************")
D BMES^XPDUTL()
;
D BMES^XPDUTL("******************************************************")
D MES^XPDUTL("Commencing conversion of existing UCIDs to "_GMRCID)
D FIXSTA3N
D BMES^XPDUTL("******************************************************")
D MES^XPDUTL("End of conversion.")
Q
;
FIXSTA3N ; Scroll through #123 "B" index. Look for any entries in #80 (UCID)
; and if the first "_" piece does not = GMRCID, then update field #80 with this
; new number.
N FMDATE,GMRCID,GMRCIEN,GMRCOUT,NEWUCID,OLDUCID,X
N DA,DIE,DR
;
S (GMRCID,GMRCIEN)=""
S (OLDUCID,NEWUCID,X)=0
;
S FMDATE="3180101"
;GMRCID = Parameter Name
S GMRCID=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC UNIQUE CONSULT SITE ID")
;
F S FMDATE=$O(^GMR(123,"B",FMDATE)) Q:FMDATE="" D
.S GMRCIEN=""
.F S GMRCIEN=$O(^GMR(123,"B",FMDATE,GMRCIEN)) Q:GMRCIEN="" D UPDATE
;
Q
;
UPDATE ;
S X=$$GET1^DIQ(123,GMRCIEN,80) ; 325_883826
I X'="" S OLDUCID=$P(X,"_",1) D
.I OLDUCID'=GMRCID D
..S NEWUCID=GMRCID_"_"_GMRCIEN
..S DR="80///"_NEWUCID
..S DIE=123
..S DA=GMRCIEN
..D ^DIE
..K GMRCOUT D GETS^DIQ(123,GMRCIEN_",",".01;.02","E","GMRCOUT")
..D MES^XPDUTL($G(GMRCOUT(123,GMRCIEN_",",.01,"E"))_" "_$G(GMRCOUT(123,GMRCIEN_",",.02,"E"))_" From: "_OLDUCID_"_"_GMRCIEN_" To: "_NEWUCID)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRC110P 2350 printed Apr 09, 2024@20:51:14 Page 2
GMRC110P ;ABV/PIJ - Consult STA3N fix. Patch GMRC*3.0*110 ;8/1/18 07:36
+1 ;;3.0;CONSULT/REQUEST TRACKING;**110**;DEC 27, 1997;Build 6
+2 ;
+3 ;This routine locates a site's STA3N ID and places it in a GMRC UNIQUE CONSULT ID parameter.
+4 ;It is used by Community Care.
+5 ;
+6 QUIT
+7 ;
POST ;updates GMRC UNIQUE CONSULT ID paramater file #8989.5
+1 NEW GMRCID
+2 ;
+3 SET GMRCID=$EXTRACT($PIECE($$SITE^VASITE(),U,3),1,3)
+4 IF GMRCID=""
Begin DoDot:1
+5 DO BMES^XPDUTL()
+6 DO MES^XPDUTL("*****************************************")
+7 DO MES^XPDUTL("Your SITE ID does not exist.")
+8 DO MES^XPDUTL("Please contact IRM for assistance.")
+9 DO MES^XPDUTL("*****************************************")
End DoDot:1
QUIT
+10 ;
+11 DO EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC UNIQUE CONSULT SITE ID",,GMRCID)
+12 ;
+13 DO BMES^XPDUTL()
+14 DO MES^XPDUTL("******************************************************")
+15 DO MES^XPDUTL("Your STATION 3N (STA3N) is "_GMRCID_" and")
+16 DO MES^XPDUTL("has been recorded in the Parameters file.")
+17 DO MES^XPDUTL("******************************************************")
+18 DO BMES^XPDUTL()
+19 ;
+20 DO BMES^XPDUTL("******************************************************")
+21 DO MES^XPDUTL("Commencing conversion of existing UCIDs to "_GMRCID)
+22 DO FIXSTA3N
+23 DO BMES^XPDUTL("******************************************************")
+24 DO MES^XPDUTL("End of conversion.")
+25 QUIT
+26 ;
FIXSTA3N ; Scroll through #123 "B" index. Look for any entries in #80 (UCID)
+1 ; and if the first "_" piece does not = GMRCID, then update field #80 with this
+2 ; new number.
+3 NEW FMDATE,GMRCID,GMRCIEN,GMRCOUT,NEWUCID,OLDUCID,X
+4 NEW DA,DIE,DR
+5 ;
+6 SET (GMRCID,GMRCIEN)=""
+7 SET (OLDUCID,NEWUCID,X)=0
+8 ;
+9 SET FMDATE="3180101"
+10 ;GMRCID = Parameter Name
+11 SET GMRCID=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC UNIQUE CONSULT SITE ID")
+12 ;
+13 FOR
SET FMDATE=$ORDER(^GMR(123,"B",FMDATE))
if FMDATE=""
QUIT
Begin DoDot:1
+14 SET GMRCIEN=""
+15 FOR
SET GMRCIEN=$ORDER(^GMR(123,"B",FMDATE,GMRCIEN))
if GMRCIEN=""
QUIT
DO UPDATE
End DoDot:1
+16 ;
+17 QUIT
+18 ;
UPDATE ;
+1 ; 325_883826
SET X=$$GET1^DIQ(123,GMRCIEN,80)
+2 IF X'=""
SET OLDUCID=$PIECE(X,"_",1)
Begin DoDot:1
+3 IF OLDUCID'=GMRCID
Begin DoDot:2
+4 SET NEWUCID=GMRCID_"_"_GMRCIEN
+5 SET DR="80///"_NEWUCID
+6 SET DIE=123
+7 SET DA=GMRCIEN
+8 DO ^DIE
+9 KILL GMRCOUT
DO GETS^DIQ(123,GMRCIEN_",",".01;.02","E","GMRCOUT")
+10 DO MES^XPDUTL($GET(GMRCOUT(123,GMRCIEN_",",.01,"E"))_" "_$GET(GMRCOUT(123,GMRCIEN_",",.02,"E"))_" From: "_OLDUCID_"_"_GMRCIEN_" To: "_NEWUCID)
End DoDot:2
End DoDot:1
+11 QUIT
