- 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 Feb 18, 2025@23:11:02 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
