Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SD132PT

SD132PT.m

Go to the documentation of this file. 
  1. SD132PT ;ALB/MJK - Patch SD*5.3*132 Post-Init Routine ; 11/5/97
  1.  ;;5.3;Scheduling;**132,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. EN ; --- main entry point
  1.  S U="^"
  1.  D BMES^XPDUTL("Post-Init Started...")
  1.  ;
  1.  ; -- main driver calls
  1.  D MAS,HL,LOG,ACG,AG,OVER
  1.  ;
  1.  D BMES^XPDUTL("Post-Init Finished.")
  1.  Q
  1.  ;
  1. MAS ; -- delete MAS PARAMETERS (#43) fields and related data
  1.  N SDARY
  1.  ;
  1.  D BMES^XPDUTL("   >>> Deleting MAS PARAMETERS (#43) fields...")
  1.  ;
  1.  ; -- get fields to delete
  1.  D BUILDR(43,.SDARY)
  1.  ;
  1.  IF '$O(SDARY(0)) G MASQ
  1.  ;
  1.  ; -- delete data
  1.  N SDFDA,SDFLD
  1.  S SDFLD=0
  1.  F  S SDFLD=$O(SDARY(SDFLD)) Q:'SDFLD  D
  1.  . S SDFDA(43,"1,",SDFLD)="@"
  1.  D FILE^DIE("S","SDFDA")
  1.  ;
  1.  ; -- delete dds
  1.  D DELDD(43)
  1. MASQ D MES^XPDUTL("   >>> Done.")
  1.  Q
  1.  ;
  1. HL ; -- delete HOSPITIAL LOCATION (#44) fields and related data
  1.  N SDARY
  1.  ;
  1.  D BMES^XPDUTL("   >>> Deleting HOSPITAL LOCATION (#44) fields...")
  1.  ;
  1.  ; -- get fields to delete
  1.  D BUILDR(44,.SDARY)
  1.  ;
  1.  IF '$O(SDARY(0)) G HLQ
  1.  ;
  1.  ; -- delete data
  1.  S SDIEN=0
  1.  F  S SDIEN=$O(^SC(SDIEN)) Q:'SDIEN  D
  1.  . N SDFDA,SDFLD
  1.  . S SDFLD=0
  1.  . F  S SDFLD=$O(SDARY(SDFLD)) Q:'SDFLD  D
  1.  . . S SDFDA(44,SDIEN_",",SDFLD)="@"
  1.  . D FILE^DIE("S","SDFDA")
  1.  ;
  1.  ; -- delete dds
  1.  D DELDD(44)
  1. HLQ D MES^XPDUTL("   >>> Done.")
  1.  Q
  1.  ;
  1. LOG ; -- delete APPOINTMENT STATUS UPDATE LOG (#409.65) fields and related data
  1.  N SDARY
  1.  ;
  1.  D BMES^XPDUTL("   >>> Deleting APPPOINT STATUS UPDATE LOG (409.65) fields...")
  1.  ;
  1.  ; -- get fields to delete
  1.  D BUILDR(409.65,.SDARY)
  1.  ;
  1.  IF '$O(SDARY(0)) G LOGQ
  1.  ;
  1.  ; -- delete data
  1.  S SDIEN=0
  1.  F  S SDIEN=$O(^SDD(409.65,SDIEN)) Q:'SDIEN  D
  1.  . N SDFDA,SDFLD
  1.  . S SDFLD=0
  1.  . F  S SDFLD=$O(SDARY(SDFLD)) Q:'SDFLD  D
  1.  . . S SDFDA(409.65,SDIEN_",",SDFLD)="@"
  1.  . D FILE^DIE("S","SDFDA")
  1.  ;
  1.  ; -- delete dds
  1.  D DELDD(409.65)
  1. LOGQ D MES^XPDUTL("   >>> Done.")
  1.  Q
  1.  ;
  1. ACG ; -- update new computer generated appt type related fields in
  1.  ;    OUTPATIENT ENCOUNTER (#409.68) with data for ^SDV data
  1.  ;
  1.  D BMES^XPDUTL("   >>> Setting 'ACG' cross references...")
  1.  ;
  1.  ; -- scan ^SDV("ACG") for records
  1.  N SDATE,SDCS,SDCS0,SDOE,SDOE0,SDREASON,SDAPPT,SDCG,DR,DA,DIE
  1.  S SDATE=0
  1.  F  S SDATE=$O(^SDV("ACG",SDATE)) Q:'SDATE  D
  1.  . S SDCS=0 F  S SDCS=$O(^SDV("ACG",SDATE,SDCS)) Q:'SDCS  D
  1.  . . S SDCS0=$G(^SDV(SDATE,"CS",SDCS,0))
  1.  . . S SDCG=+$G(^SDV(SDATE,"CS",SDCS,1))
  1.  . . S SDAPPT=$P(SDCS0,U,5)
  1.  . . S SDREASON=$P(SDCS0,U,6)
  1.  . . S SDOE=+$P(SDCS0,U,8)
  1.  . . S SDOE0=$G(^SCE(SDOE,0))
  1.  . . IF SDAPPT=10,SDOE,$P(SDOE0,U,10)=10,$G(^SCE(SDOE,"CG"))="" D
  1.  . . . S DR=".1////10"
  1.  . . . IF SDCG S DR=DR_";201////1"
  1.  . . . IF SDREASON S DR=DR_";202////"_SDREASON
  1.  . . . S DIE="^SCE(",DA=SDOE D ^DIE
  1.  ;
  1.  D MES^XPDUTL("   >>> Done.")
  1.  Q
  1.  ;
  1. AG ; -- queue job to set 'AG' xref and related fields
  1.  N SDUZ,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSAVE,ZTSK
  1.  S SDUZ=$G(DUZ)
  1.  D BMES^XPDUTL("   >>> Queuing task to set 'AG' cross reference.")
  1.  ; -- disable option
  1.  D OUT^XPDMENU("SDACS CGSCLIST","AG Cross Reference Being Set")
  1.  D MES^XPDUTL("       -> Option 'SDACS CGSCLIST' has been placed out of service.")
  1.  ;
  1.  ; -- queue task
  1.  S ZTIO=""
  1.  S ZTRTN="AGQUE^SD132PT"
  1.  S ZTDESC="Setting 'AG' Cross Reference"
  1.  S ZTDTH=$$NOW^XLFDT()
  1.  F X="SDUZ" S ZTSAVE(X)=""
  1.  D ^%ZTLOAD
  1.  D:$D(ZTSK) MES^XPDUTL("       -> Task: #"_ZTSK)
  1.  D MES^XPDUTL("   >>> Done.")
  1.  Q
  1.  ;
  1. AGQUE ; -- TaskMan entry point to queue 'AG' setting
  1.  ;
  1.  N SDATE,SDCS,SDCS0,SDOE,SDREASON,SDCG,DR,DA,DIE,SDSTOP,SDTOT,SDBEG,SDEND
  1.  ;
  1.  S SDTOT=0
  1.  S SDBEG=$$NOW^XLFDT()
  1.  ;
  1.  ; -- scan ^SDV("AG") for records
  1.  S SDATE=0
  1.  F  S SDATE=$O(^SDV("AG",SDATE)) Q:'SDATE  D  S SDSTOP=$$S^%ZTLOAD Q:SDSTOP
  1.  . S SDCS=0 F  S SDCS=$O(^SDV("AG",SDATE,SDCS)) Q:'SDCS  D
  1.  . . S SDCS0=$G(^SDV(SDATE,"CS",SDCS,0))
  1.  . . S SDCG=+$G(^SDV(SDATE,"CS",SDCS,1))
  1.  . . S SDOE=+$P(SDCS0,U,8)
  1.  . . S SDREASON=$P(SDCS0,U,6)
  1.  . . IF SDOE,$G(^SCE(SDOE,0))]"",$G(^SCE(SDOE,"CG"))="",SDCG D
  1.  . . . S DR="201////1"
  1.  . . . IF SDREASON S DR=DR_";202////"_SDREASON
  1.  . . . S DIE="^SCE(",DA=SDOE D ^DIE
  1.  . . . S SDTOT=SDTOT+1
  1.  ;
  1.  S SDEND=$$NOW^XLFDT()
  1.  ; -- send bulletin and enable option
  1.  D BULL
  1.  Q
  1.  ;
  1. BULL ; -- send message indicating 'AG' xref is set and option enabled
  1.  N SDTEXT,SDCNT,XMSUB,XMN,XMTEXT,XMDUZ,XMY
  1.  S SDCNT=0
  1.  ;
  1.  D LINE("")
  1.  D LINE("  >>>  Task Started: "_$$FMTE^XLFDT(SDBEG))
  1.  D LINE("           Finished: "_$$FMTE^XLFDT(SDEND))
  1.  D LINE("")
  1.  ;
  1.  ; -- build text
  1.  IF SDSTOP D
  1.  . D LINE("   >>> Task stopped by user. <<<")
  1.  ELSE  D
  1.  . ; -- enable option
  1.  . D OUT^XPDMENU("SDACS CGSCLIST","")
  1.  . ;
  1.  . ; -- build text
  1.  . D LINE("   >>> Task Completed.")
  1.  . D LINE("")
  1.  . D LINE("   >>> Option 'SDACS CGSCLIST' is back in service.")
  1.  ;
  1.  D LINE("")
  1.  D LINE("   >>> "_SDTOT_" Records processed.")
  1.  ; -- set xm vars and send message
  1.  S XMSUB="Setting of 'AG' Cross Reference Task Information"
  1.  S XMN=0
  1.  S XMTEXT="SDTEXT("
  1.  S XMDUZ=.5
  1.  S XMY(SDUZ)=""
  1.  D ^XMD
  1.  Q
  1.  ;
  1. OVER ; -- post override flag information
  1.  N SDPKG,SDCNT
  1.  ;
  1.  D BMES^XPDUTL("   >>> Package Override Flag Information")
  1.  ;
  1.  S SDPKG="A",SDCNT=0
  1.  F  S SDPKG=$O(^XTMP("SD*5.3*132 OVERRIDE FLAGS",SDPKG)) Q:SDPKG=""  D
  1.  . D MES^XPDUTL("       -> Override flag set for '"_SDPKG_"'")
  1.  . S SDCNT=SDCNT+1
  1.  ;
  1.  IF 'SDCNT D MES^XPDUTL("       -> No package override flags set.")
  1.  D MES^XPDUTL("   >>> Done.")
  1.  Q
  1.  ;
  1. LINE(TEXT) ; -- add line of text
  1.  S SDCNT=SDCNT+1
  1.  S SDTEXT(SDCNT)=TEXT
  1.  Q
  1.  ;
  1. BUILDR(SDD,SDARY) ; -- build array of fields to delete
  1.  N SDI,SDX,SDENDFLG
  1.  S SDENDFLG="$$END$$"
  1.  ;
  1.  F SDI=1:1 S SDX=$P($T(FLDS+SDI),";;",2) Q:SDX=SDENDFLG  D
  1.  . N SDFILE,SDFLD
  1.  . S SDFILE=+SDX
  1.  . S SDFLD=+$P(SDX,U,2)
  1.  . S SDNAME=$P(SDX,U,3)
  1.  . IF SDD=SDFILE,$$LABEL(SDFILE,SDFLD)=SDNAME D
  1.  . . S SDARY(SDFLD)=""
  1.  Q
  1.  ;
  1. DELDD(SDD) ; -- tool to delete fields dd
  1.  ; -- delete dd
  1.  N SDI,SDX,SDENDFLG,SDCNT
  1.  S SDENDFLG="$$END$$"
  1.  S SDCNT=0
  1.  ;
  1.  ; -- delete dds
  1.  F SDI=1:1 S SDX=$P($T(FLDS+SDI),";;",2) Q:SDX=SDENDFLG  D
  1.  . N SDFILE,SDFLD,SDNAME
  1.  . S SDFILE=+SDX
  1.  . S SDFLD=+$P(SDX,U,2)
  1.  . S SDNAME=$P(SDX,U,3)
  1.  . ;
  1.  . ; -- make sure field is not reused before deleting
  1.  . IF SDD=SDFILE,$$LABEL(SDFILE,SDFLD)=SDNAME D
  1.  . . N DIK,DA
  1.  . . S DIK="^DD("_SDD_",",DA=SDFLD,DA(1)=SDD D ^DIK
  1.  . . D MSG(SDFLD,SDNAME)
  1.  . . S SDCNT=SDCNT+1
  1.  ;
  1.  IF 'SDCNT D MES^XPDUTL("       -> Fields already deleted.")
  1.  Q
  1.  ;
  1. LABEL(SDFILE,SDFLD) ; -- get label if not deleted
  1.  N SDY
  1.  D FIELD^DID(SDFILE,SDFLD,"N","LABEL","SDY")
  1.  Q $G(SDY("LABEL"))
  1.  ;
  1. MSG(SDFLD,SDNAME) ; -- tell user (use kids call??) 
  1.  D MES^XPDUTL("       -> Field '"_SDFLD_" - "_SDNAME_"' deleted.")
  1.  Q
  1.  ;
  1. FLDS ; -- fields to be deleted [ file# ^ field# ^ field label ]
  1.  ;;43^201^SPEC SURVEY DISP LAST RUN
  1.  ;;43^202^OPC FILE LAST RUN
  1.  ;;43^203^OPC TRANSMISSION LAST RUN
  1.  ;;43^204^GENERATING OPC FILE NOW?
  1.  ;;43^206^AMB PROC INITIALIZATION DATE
  1.  ;;43^206.1^OPC VLR DATE
  1.  ;;43^206.2^OPC MT INCOME DATE
  1.  ;;43^207^OPC STOP CODE CONVERSION DATE
  1.  ;;43^208^OPC GENERATION START DATE
  1.  ;;43^209^OPC GENERATION END DATE
  1.  ;;43^214^GEN OPC W/APPT STATUS UPDATE
  1.  ;;43^221^STOP CODE MAIL GROUP
  1.  ;;43^218^OPC FY93 FORMAT DATE
  1.  ;;43^219^ASK PROVIDER ON DISPOSITION
  1.  ;;43^220^ASK DIAGNOSIS ON DISPOSITION
  1.  ;;43^222^OPC FY94 FORMAT DATE
  1.  ;;43^225^OPC FY95 FORMAT DATE
  1.  ;;44^25^PROCEDURE CHECK-OFF SHEET
  1.  ;;44^26^ASK PROVIDER AT CHECK OUT
  1.  ;;44^27^ASK DIAGNOSIS AT CHECK OUT
  1.  ;;44^28^ASK STOP CODES AT CHECK OUT
  1.  ;;409.65^.06^OPC LAST GENERATED
  1.  ;;409.65^.07^OPC LAST TRANSMITTED
  1.  ;;409.65^.08^OPC LAST GENERATED BY
  1.  ;;409.65^.09^OPC LAST TRANSMITTED BY
  1.  ;;$$END$$