GMRC3P52 ;ALB/MRY - POST INIT ;04/14/06
;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
;
EN ;
S XPDABORT=""
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D G ABRT
. D BMES^XPDUTL("*****")
. D MES^XPDUTL("Your programming variables are not set up properly.")
. D MES^XPDUTL("Installation aborted.")
W !!,">> Environment check complete and okay."
I XPDABORT="" K XPDABORT
Q
;
ABRT ; Abort transport, but leave in ^XTMP.
S XPDABORT=2 Q
;
PRE ;Set seed flag, so, 'AHST' xref of the new Consult Link field (#688)
;of the Hospital Location file (#44) doesn't get set during install.
S SDSEED=1
Q
POST ;-------------------------------------------------------------------
;Add option to menu.
N GMRCOK
S GMRCOK=$$ADD^XPDMENU("GMRC REPORTS","GMRC RPT SD SCH-MGT CONSULTS","SH",6)
D BMES^XPDUTL("*****")
I GMRCOK=1 D
.D MES^XPDUTL("Adding option 'Service Consults Schedule-Management Report'")
.D MES^XPDUTL(" to 'Consult Tracking Reports' menu.")
E D
.D MES^XPDUTL("Error - 'Service Consults Schedule-Management Report' option not added.")
.D BMES^XPDUTL("*****")
;
;---------------------------------------------------------------------
;Post-init for sites running Class 3 software.
;
;Quit, if Class 3 field not installed.
;
;File 123.5
; Loop down Class 3 ^GMR("AB" xref. to build new entries.
; Sites can remove Class 3 field when satisfied of changes.
;
;---------------------------------------------------------------------
;Convert #123.5 Class 3 ASSOCIATED STOP CODE field and xrefs.
I '$D(^GMR(123.5,"AB")),'$D(^XTMP("GMRC3P52")) Q ;quit, no Class 3 data.
D BMES^XPDUTL("*****")
N GMRX,GMRDA,GMRSTOP,DIC
;Check/create ^XTMP for conversion run to completion.
I $D(^XTMP("GMRC3P52")) D I $G(GMRSTOP) G CONS
. I $P($G(^XTMP("GMRC3P52",1)),U,2)="DONE" D
.. S GMRSTOP=1
.. D MES^XPDUTL("Conversion of Class III Associated Stop Codes already run to completion.")
.. D MES^XPDUTL(" ")
. E S GMRX=+$P($G(^XTMP("GMRC3P52",1)),U)
E S ^XTMP("GMRC3P52",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
D MES^XPDUTL("...Moving File #123.5, ASSOCIATED STOP CODE (Class 3) field entries...")
D MES^XPDUTL(" ")
I $G(GMRX)']0 S GMRX=0
F S GMRX=$O(^GMR(123.5,"AB",GMRX)) Q:'GMRX D
. S GMRDA=0 F S GMRDA=$O(^GMR(123.5,"AB",GMRX,GMRDA)) Q:'GMRDA D
.. ;check for duplicate. FILE^DICN call will add duplicates.
.. I +$O(^GMR(123.5,"AB1",GMRX,GMRDA,0)) Q
.. K DIC("DR")
.. S DA(1)=GMRDA
.. S DIC="^GMR(123.5,"_DA(1)_",688,"
.. S DIC(0)="L",DIC("P")=$P(^DD(123.5,688,0),"^",2)
.. S DIC("DR")="688///"_GMRX
.. S X=GMRX
.. K D0 D FILE^DICN
.. I Y=-1 Q
.. S $P(^XTMP("GMRC3P52",1),U)=GMRX
S $P(^XTMP("GMRC3P52",1),U,2)="DONE"
;
CONS ;---------------------------------------------------------------------
;Post-init for sites running Class 3 software.
;
;Quit, if Class 3 field not installed.
;
;File 44
; Loop down Class 3 ^SC("AWAS" xref. to build new entries.
;---------------------------------------------------------------------
;
;Convert HOSPITAL LOCATION Class III CONSULT LINK field and xrefs.
I '$D(^SC("AWAS")),'$D(^XTMP("SD53P478")) Q ;quit, no Class 3 data
N CNSLTLNK,SDC,SDT,SDY,DA,DIE,DR,SDSTOP
;Check/create ^XTMP for conversion run to completion.
I $D(^XTMP("SD53P478")) D I $G(SDSTOP) Q
. I $P($G(^XTMP("SD53P478",1)),U,2)="DONE" D
.. S SDSTOP=1
.. D MES^XPDUTL("Conversion of Class III Consult Link entries already run to completion.")
.. D MES^XPDUTL(" ")
. E S CNSLTLNK=+$P($G(^XTMP("SD53P478",1)),U)
E S ^XTMP("SD53P478",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
D MES^XPDUTL("...Moving File #44, CONSULT LINK (Class 3) field entries...")
;Loop down Class III CONSULT LINK "AWAS" xref (if exits).
I $G(CNSLTLNK)']0 S CNSLTLNK=0
F S CNSLTLNK=$O(^SC("AWAS",CNSLTLNK)) Q:'CNSLTLNK D
.S SDC=0 F S SDC=$O(^SC("AWAS",CNSLTLNK,SDC)) Q:'SDC D
..S SDT=0 F S SDT=$O(^SC("AWAS",CNSLTLNK,SDC,SDT)) Q:'SDT D
...S SDY=0 F S SDY=$O(^SC("AWAS",CNSLTLNK,SDC,SDT,SDY)) Q:'SDY D
....;don't process if already exists (install rerun).
....Q:$D(^SC("AWAS1",CNSLTLNK,SDC,SDT,SDY))
....;create Class I CONSULT LINK field and xrefs.
....S DA(2)=SDC,DA(1)=SDT,DA=SDY
....S DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,",DR="688////^S X=CNSLTLNK"
....D ^DIE
. S $P(^XTMP("SD53P478",1),U)=CNSLTLNK
S $P(^XTMP("SD53P478",1),U,2)="DONE"
;move Class 3 'AHST' Consult history to new 'AHST1' xref.
D MES^XPDUTL(" ....Restoring historical cross reference entries.")
M ^SC("AHST1")=^SC("AHST")
D BMES^XPDUTL("Class III Conversion Complete.")
K SDSEED
D BMES^XPDUTL("*****")
;
NOTIFY ;Send notification
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
I '$G(GMRSTOP),'$G(SDSTOP),($P($G(^XTMP("GMRC3P52",1)),U,2)="DONE"),($P($G(^XTMP("SD53P478",1)),U,2)="DONE") D
. S XMDUZ="APPOINTMENT/CONSULT LINK"
. S XMSUB="Class 3 Consults Conversion Complete"
. S XMTEXT="^TMP(""GMRC3P52"",$J,"
. S XMY(DUZ)=""
. S ^TMP("GMRC3P52",$J,1)=" "
. S ^TMP("GMRC3P52",$J,2)="The conversion of your ASSOCIATED STOP CODES and CONSULT LINK Class III entries"
. S ^TMP("GMRC3P52",$J,3)="to the new Class I fields in patch SD*5.3*478 has successfully completed."
. S ^TMP("GMRC3P52",$J,4)=" "
. S ^TMP("GMRC3P52",$J,5)="After completely satified with you conversion, please follow the instructions"
. S ^TMP("GMRC3P52",$J,6)="in the Patch Installation Guide for removing your Class III fields."
. D ^XMD K ^TMP("GMRC3P52",$J),XMY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRC3P52 5524 printed Nov 22, 2024@16:55:03 Page 2
GMRC3P52 ;ALB/MRY - POST INIT ;04/14/06
+1 ;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
+2 ;
EN ;
+1 SET XPDABORT=""
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("*****")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
End DoDot:1
GOTO ABRT
+6 WRITE !!,">> Environment check complete and okay."
+7 IF XPDABORT=""
KILL XPDABORT
+8 QUIT
+9 ;
ABRT ; Abort transport, but leave in ^XTMP.
+1 SET XPDABORT=2
QUIT
+2 ;
PRE ;Set seed flag, so, 'AHST' xref of the new Consult Link field (#688)
+1 ;of the Hospital Location file (#44) doesn't get set during install.
+2 SET SDSEED=1
+3 QUIT
POST ;-------------------------------------------------------------------
+1 ;Add option to menu.
+2 NEW GMRCOK
+3 SET GMRCOK=$$ADD^XPDMENU("GMRC REPORTS","GMRC RPT SD SCH-MGT CONSULTS","SH",6)
+4 DO BMES^XPDUTL("*****")
+5 IF GMRCOK=1
Begin DoDot:1
+6 DO MES^XPDUTL("Adding option 'Service Consults Schedule-Management Report'")
+7 DO MES^XPDUTL(" to 'Consult Tracking Reports' menu.")
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 DO MES^XPDUTL("Error - 'Service Consults Schedule-Management Report' option not added.")
+10 DO BMES^XPDUTL("*****")
End DoDot:1
+11 ;
+12 ;---------------------------------------------------------------------
+13 ;Post-init for sites running Class 3 software.
+14 ;
+15 ;Quit, if Class 3 field not installed.
+16 ;
+17 ;File 123.5
+18 ; Loop down Class 3 ^GMR("AB" xref. to build new entries.
+19 ; Sites can remove Class 3 field when satisfied of changes.
+20 ;
+21 ;---------------------------------------------------------------------
+22 ;Convert #123.5 Class 3 ASSOCIATED STOP CODE field and xrefs.
+23 ;quit, no Class 3 data.
IF '$DATA(^GMR(123.5,"AB"))
IF '$DATA(^XTMP("GMRC3P52"))
QUIT
+24 DO BMES^XPDUTL("*****")
+25 NEW GMRX,GMRDA,GMRSTOP,DIC
+26 ;Check/create ^XTMP for conversion run to completion.
+27 IF $DATA(^XTMP("GMRC3P52"))
Begin DoDot:1
+28 IF $PIECE($GET(^XTMP("GMRC3P52",1)),U,2)="DONE"
Begin DoDot:2
+29 SET GMRSTOP=1
+30 DO MES^XPDUTL("Conversion of Class III Associated Stop Codes already run to completion.")
+31 DO MES^XPDUTL(" ")
End DoDot:2
+32 IF '$TEST
SET GMRX=+$PIECE($GET(^XTMP("GMRC3P52",1)),U)
End DoDot:1
IF $GET(GMRSTOP)
GOTO CONS
+33 IF '$TEST
SET ^XTMP("GMRC3P52",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
+34 DO MES^XPDUTL("...Moving File #123.5, ASSOCIATED STOP CODE (Class 3) field entries...")
+35 DO MES^XPDUTL(" ")
+36 IF $GET(GMRX)']0
SET GMRX=0
+37 FOR
SET GMRX=$ORDER(^GMR(123.5,"AB",GMRX))
if 'GMRX
QUIT
Begin DoDot:1
+38 SET GMRDA=0
FOR
SET GMRDA=$ORDER(^GMR(123.5,"AB",GMRX,GMRDA))
if 'GMRDA
QUIT
Begin DoDot:2
+39 ;check for duplicate. FILE^DICN call will add duplicates.
+40 IF +$ORDER(^GMR(123.5,"AB1",GMRX,GMRDA,0))
QUIT
+41 KILL DIC("DR")
+42 SET DA(1)=GMRDA
+43 SET DIC="^GMR(123.5,"_DA(1)_",688,"
+44 SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(123.5,688,0),"^",2)
+45 SET DIC("DR")="688///"_GMRX
+46 SET X=GMRX
+47 KILL D0
DO FILE^DICN
+48 IF Y=-1
QUIT
+49 SET $PIECE(^XTMP("GMRC3P52",1),U)=GMRX
End DoDot:2
End DoDot:1
+50 SET $PIECE(^XTMP("GMRC3P52",1),U,2)="DONE"
+51 ;
CONS ;---------------------------------------------------------------------
+1 ;Post-init for sites running Class 3 software.
+2 ;
+3 ;Quit, if Class 3 field not installed.
+4 ;
+5 ;File 44
+6 ; Loop down Class 3 ^SC("AWAS" xref. to build new entries.
+7 ;---------------------------------------------------------------------
+8 ;
+9 ;Convert HOSPITAL LOCATION Class III CONSULT LINK field and xrefs.
+10 ;quit, no Class 3 data
IF '$DATA(^SC("AWAS"))
IF '$DATA(^XTMP("SD53P478"))
QUIT
+11 NEW CNSLTLNK,SDC,SDT,SDY,DA,DIE,DR,SDSTOP
+12 ;Check/create ^XTMP for conversion run to completion.
+13 IF $DATA(^XTMP("SD53P478"))
Begin DoDot:1
+14 IF $PIECE($GET(^XTMP("SD53P478",1)),U,2)="DONE"
Begin DoDot:2
+15 SET SDSTOP=1
+16 DO MES^XPDUTL("Conversion of Class III Consult Link entries already run to completion.")
+17 DO MES^XPDUTL(" ")
End DoDot:2
+18 IF '$TEST
SET CNSLTLNK=+$PIECE($GET(^XTMP("SD53P478",1)),U)
End DoDot:1
IF $GET(SDSTOP)
QUIT
+19 IF '$TEST
SET ^XTMP("SD53P478",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
+20 DO MES^XPDUTL("...Moving File #44, CONSULT LINK (Class 3) field entries...")
+21 ;Loop down Class III CONSULT LINK "AWAS" xref (if exits).
+22 IF $GET(CNSLTLNK)']0
SET CNSLTLNK=0
+23 FOR
SET CNSLTLNK=$ORDER(^SC("AWAS",CNSLTLNK))
if 'CNSLTLNK
QUIT
Begin DoDot:1
+24 SET SDC=0
FOR
SET SDC=$ORDER(^SC("AWAS",CNSLTLNK,SDC))
if 'SDC
QUIT
Begin DoDot:2
+25 SET SDT=0
FOR
SET SDT=$ORDER(^SC("AWAS",CNSLTLNK,SDC,SDT))
if 'SDT
QUIT
Begin DoDot:3
+26 SET SDY=0
FOR
SET SDY=$ORDER(^SC("AWAS",CNSLTLNK,SDC,SDT,SDY))
if 'SDY
QUIT
Begin DoDot:4
+27 ;don't process if already exists (install rerun).
+28 if $DATA(^SC("AWAS1",CNSLTLNK,SDC,SDT,SDY))
QUIT
+29 ;create Class I CONSULT LINK field and xrefs.
+30 SET DA(2)=SDC
SET DA(1)=SDT
SET DA=SDY
+31 SET DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"
SET DR="688////^S X=CNSLTLNK"
+32 DO ^DIE
End DoDot:4
End DoDot:3
End DoDot:2
+33 SET $PIECE(^XTMP("SD53P478",1),U)=CNSLTLNK
End DoDot:1
+34 SET $PIECE(^XTMP("SD53P478",1),U,2)="DONE"
+35 ;move Class 3 'AHST' Consult history to new 'AHST1' xref.
+36 DO MES^XPDUTL(" ....Restoring historical cross reference entries.")
+37 MERGE ^SC("AHST1")=^SC("AHST")
+38 DO BMES^XPDUTL("Class III Conversion Complete.")
+39 KILL SDSEED
+40 DO BMES^XPDUTL("*****")
+41 ;
NOTIFY ;Send notification
+1 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+2 IF '$GET(GMRSTOP)
IF '$GET(SDSTOP)
IF ($PIECE($GET(^XTMP("GMRC3P52",1)),U,2)="DONE")
IF ($PIECE($GET(^XTMP("SD53P478",1)),U,2)="DONE")
Begin DoDot:1
+3 SET XMDUZ="APPOINTMENT/CONSULT LINK"
+4 SET XMSUB="Class 3 Consults Conversion Complete"
+5 SET XMTEXT="^TMP(""GMRC3P52"",$J,"
+6 SET XMY(DUZ)=""
+7 SET ^TMP("GMRC3P52",$JOB,1)=" "
+8 SET ^TMP("GMRC3P52",$JOB,2)="The conversion of your ASSOCIATED STOP CODES and CONSULT LINK Class III entries"
+9 SET ^TMP("GMRC3P52",$JOB,3)="to the new Class I fields in patch SD*5.3*478 has successfully completed."
+10 SET ^TMP("GMRC3P52",$JOB,4)=" "
+11 SET ^TMP("GMRC3P52",$JOB,5)="After completely satified with you conversion, please follow the instructions"
+12 SET ^TMP("GMRC3P52",$JOB,6)="in the Patch Installation Guide for removing your Class III fields."
+13 DO ^XMD
KILL ^TMP("GMRC3P52",$JOB),XMY
End DoDot:1
+14 QUIT
