- 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
- 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
