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

AUMDO.m

Go to the documentation of this file. 
  1. AUMDO ; IHS/OIRM/DSD/JCM,AEF - ENTRY PROGRAM FOR UPDATING ICD0 AND ICD9 FILES ;  [ 12/03/1998   2:35 PM ]
  1.  ;;99.1;ICD UPDATE;;DEC 03, 1998
  1.  W !,"ENTRY NOT PERMITTED HERE (^AUMDO)" Q
  1.  ; This is the main calling routine to update the ICD0 and ICD9 files
  1.  ; It is called either by DOing PGRMODE^AUMDO in programmer mode
  1.  ; or from TASKMAN by scheduling it with the AUMDO option.
  1.  ; If the AUMDDTMP or AUMDOTMP update globals do not exist,
  1.  ; then that file is not updated.
  1.  ;
  1. SPECNOTE ; SPECIAL NOTE FOR PROGRAMMERS
  1.  ; ***NOTE - ALL VARIABLES ARE IN THE AUMDO("variable name') ARRAY
  1.  ;
  1. PGRMODE ; ENTRY POINT FROM AUMDO^AUMD
  1.  ; GET OUTPUT DEVICE AND/OR QUEUE TO TASKMAN
  1.  D EN^AUMDODEV
  1.  I $D(IO("Q"))!(POP) K POP Q  ;QUIT IF QUEUED TO TASKMAN
  1.  ;
  1. EN ; ENTRY POINT FROM TASKMAN IF OUTPUT IS QUEUED
  1.  U IO
  1.  D ^XBKVAR ; GET KERNEL VARIABLES
  1.  F AUMDO("ICD FILE")="ICD0","ICD9" D INITVAR,EN^AUMDO1:'AUMDO("QUIT")
  1.  D UPDATE^AUMDOPKG ;AEF 2981030
  1.  D CLEANUP
  1.  Q  ; END OF JOB - RETURN TO SYSTEM
  1. INITVAR ; INITIALIZE VARIABLES AND CHECK FOR EXISTANCE OF UPDATE GLOBAL
  1.  S (AUMDO("PAGE #"),AUMDO("QUIT"),AUMDO("ICD0"),AUMDO("ICD9"))=0
  1.  S AUMDO(AUMDO("ICD FILE"))=1 ; SET ICD FILE FLAG
  1.  ; CHECK TO SEE IF THERE IS AN UPDATE GLOBAL
  1.  I $D(@$S(AUMDO("ICD0"):"^AUMDOTMP",AUMDO("ICD9"):"^AUMDDTMP"))
  1.  E  W "AUMDO - **** Update global file ^AUMDO"_$S(AUMDO("ICD0"):"OP",AUMDO("ICD9"):"DX")_"U does not exist! ****",!,?10,"**** "_AUMDO("ICD FILE")_" update not performed. ****",!! S AUMDO("QUIT")=1 Q  ; SET QUIT FLAG
  1.  S $P(AUMDO("DASHES"),"-",80)=""
  1.  S AUMDO("UPD GL REF")=$S(AUMDO("ICD0"):"^AUMDOTMP(",AUMDO("ICD9"):"^AUMDDTMP(")
  1.  S AUMDO("ICD GL REF")=$S(AUMDO("ICD0"):"^ICD0(",AUMDO("ICD9"):"^ICD9(")
  1.  S AUMDO("DLAYGO ICD")=$S(AUMDO("ICD0"):80.1,AUMDO("ICD9"):80)
  1.  S AUMDO("DLAYGO DRG")=$S(AUMDO("ICD0"):80.11,AUMDO("ICD9"):80.01)
  1.  S AUMDO("DLAYGO MDC")=80.12
  1.  S AUMDO("DLAYGO KWD")=$S(AUMDO("ICD0"):"80.1999999921",AUMDO("ICD9"):"80.999999921")
  1.  S AUMDO("DIC(P) DRG")=$S(AUMDO("ICD0"):"^DD(80.1,6,0)",AUMDO("ICD9"):"^DD(80,6,0)")
  1.  S AUMDO("DIC(P) KWD")=$S(AUMDO("ICD0"):"^DD(80.1,9999999.21,0)",AUMDO("ICD9"):"^DD(80,9999999.21,0)")
  1.  S AUMDO("DIC(P) MDC")="^DD(80.1,7,0)"
  1.  S AUMDO("ICD CODE")=9999999
  1.  S (AUMDO("TOTAL UPDATE RECORDS"),AUMDO("TOTAL GOOD UPDATE RECORDS"),AUMDO("TOTAL BAD UPDATE RECORDS"),AUMDO("TOTAL ADDS"),AUMDO("TOTAL ADD/REPLACE"),AUMDO("TOTAL CHANGES"))=0 ; SET COUNTERS AND START $O VALUE
  1.  D HDR ; PRINT HEADING
  1.  Q
  1. CLEANUP ; KILL AUMDO* QUIT GRACEFULLY
  1.  K AUMDO
  1.  D ^%ZISC
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1. HDR ; ENTRY POINT FROM MULTIPLE POINTS IN ^AUMDO1,^AUMDO1A,^AUMDO1B,^AUMDO1BS,^AUMDO1C TO PRINT PAGE HEADINGS
  1.  S AUMDO("PAGE #")=AUMDO("PAGE #")+1
  1.  D NOW^%DTC S Y=% X ^DD("DD") ; GET DATE/TIME
  1.  S AUMDO("DATE")=$P(Y,"@"),AUMDO("TIME")=$E($P(Y,"@",2),1,5)
  1.  W:$D(IOF) @IOF
  1.  W AUMDO("DASHES"),!
  1.  W ?5,"I C D "_$E(AUMDO("ICD FILE"),4)_"    O N - L I N E   U P D A T E   A C T I V I T Y",?65,"Page # "_AUMDO("PAGE #"),!,AUMDO("DASHES"),!,AUMDO("DATE")_" at "_AUMDO("TIME"),!
  1.  Q