AUMDO.m

AUMDO ; IHS/OIRM/DSD/JCM,AEF - ENTRY PROGRAM FOR UPDATING ICD0 AND ICD9 FILES ;  [ 12/03/1998   2:35 PM ]

 ;;99.1;ICD UPDATE;;DEC 03, 1998

 W !,"ENTRY NOT PERMITTED HERE (^AUMDO)" Q

 ; This is the main calling routine to update the ICD0 and ICD9 files

 ; It is called either by DOing PGRMODE^AUMDO in programmer mode

 ; or from TASKMAN by scheduling it with the AUMDO option.

 ; If the AUMDDTMP or AUMDOTMP update globals do not exist,

 ; then that file is not updated.

 ;

SPECNOTE ; SPECIAL NOTE FOR PROGRAMMERS

 ; ***NOTE - ALL VARIABLES ARE IN THE AUMDO("variable name') ARRAY

 ;

PGRMODE ; ENTRY POINT FROM AUMDO^AUMD

 ; GET OUTPUT DEVICE AND/OR QUEUE TO TASKMAN

 D EN^AUMDODEV

 I $D(IO("Q"))!(POP) K POP Q  ;QUIT IF QUEUED TO TASKMAN

 ;

EN ; ENTRY POINT FROM TASKMAN IF OUTPUT IS QUEUED

 U IO

 D ^XBKVAR ; GET KERNEL VARIABLES

 F AUMDO("ICD FILE")="ICD0","ICD9" D INITVAR,EN^AUMDO1:'AUMDO("QUIT")

 D UPDATE^AUMDOPKG ;AEF 2981030

 D CLEANUP

 Q  ; END OF JOB - RETURN TO SYSTEM

INITVAR ; INITIALIZE VARIABLES AND CHECK FOR EXISTANCE OF UPDATE GLOBAL

 S (AUMDO("PAGE #"),AUMDO("QUIT"),AUMDO("ICD0"),AUMDO("ICD9"))=0

 S AUMDO(AUMDO("ICD FILE"))=1 ; SET ICD FILE FLAG

 ; CHECK TO SEE IF THERE IS AN UPDATE GLOBAL

 I $D(@$S(AUMDO("ICD0"):"^AUMDOTMP",AUMDO("ICD9"):"^AUMDDTMP"))

 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

 S $P(AUMDO("DASHES"),"-",80)=""

 S AUMDO("UPD GL REF")=$S(AUMDO("ICD0"):"^AUMDOTMP(",AUMDO("ICD9"):"^AUMDDTMP(")

 S AUMDO("ICD GL REF")=$S(AUMDO("ICD0"):"^ICD0(",AUMDO("ICD9"):"^ICD9(")

 S AUMDO("DLAYGO ICD")=$S(AUMDO("ICD0"):80.1,AUMDO("ICD9"):80)

 S AUMDO("DLAYGO DRG")=$S(AUMDO("ICD0"):80.11,AUMDO("ICD9"):80.01)

 S AUMDO("DLAYGO MDC")=80.12

 S AUMDO("DLAYGO KWD")=$S(AUMDO("ICD0"):"80.1999999921",AUMDO("ICD9"):"80.999999921")

 S AUMDO("DIC(P) DRG")=$S(AUMDO("ICD0"):"^DD(80.1,6,0)",AUMDO("ICD9"):"^DD(80,6,0)")

 S AUMDO("DIC(P) KWD")=$S(AUMDO("ICD0"):"^DD(80.1,9999999.21,0)",AUMDO("ICD9"):"^DD(80,9999999.21,0)")

 S AUMDO("DIC(P) MDC")="^DD(80.1,7,0)"

 S AUMDO("ICD CODE")=9999999

 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

 D HDR ; PRINT HEADING

 Q

CLEANUP ; KILL AUMDO* QUIT GRACEFULLY

 K AUMDO

 D ^%ZISC

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

HDR ; ENTRY POINT FROM MULTIPLE POINTS IN ^AUMDO1,^AUMDO1A,^AUMDO1B,^AUMDO1BS,^AUMDO1C TO PRINT PAGE HEADINGS

 S AUMDO("PAGE #")=AUMDO("PAGE #")+1

 D NOW^%DTC S Y=% X ^DD("DD") ; GET DATE/TIME

 S AUMDO("DATE")=$P(Y,"@"),AUMDO("TIME")=$E($P(Y,"@",2),1,5)

 W:$D(IOF) @IOF

 W AUMDO("DASHES"),!

 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"),!

 Q

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

 +2        WRITE !,"ENTRY NOT PERMITTED HERE (^AUMDO)"

           QUIT 

 +3       ; This is the main calling routine to update the ICD0 and ICD9 files

 +4       ; It is called either by DOing PGRMODE^AUMDO in programmer mode

 +5       ; or from TASKMAN by scheduling it with the AUMDO option.

 +6       ; If the AUMDDTMP or AUMDOTMP update globals do not exist,

 +7       ; then that file is not updated.

 +8       ;

SPECNOTE  ; SPECIAL NOTE FOR PROGRAMMERS

 +1       ; ***NOTE - ALL VARIABLES ARE IN THE AUMDO("variable name') ARRAY

 +2       ;

PGRMODE   ; ENTRY POINT FROM AUMDO^AUMD

 +1       ; GET OUTPUT DEVICE AND/OR QUEUE TO TASKMAN

 +2        DO EN^AUMDODEV

 +3       ;QUIT IF QUEUED TO TASKMAN

           IF $DATA(IO("Q"))!(POP)

               KILL POP

               QUIT 

 +4       ;

EN        ; ENTRY POINT FROM TASKMAN IF OUTPUT IS QUEUED

 +1        USE IO

 +2       ; GET KERNEL VARIABLES

           DO ^XBKVAR

 +3        FOR AUMDO("ICD FILE")="ICD0","ICD9"

               DO INITVAR

               IF 'AUMDO("QUIT")

                   DO EN^AUMDO1

 +4       ;AEF 2981030

           DO UPDATE^AUMDOPKG

 +5        DO CLEANUP

 +6       ; END OF JOB - RETURN TO SYSTEM

           QUIT 

INITVAR   ; INITIALIZE VARIABLES AND CHECK FOR EXISTANCE OF UPDATE GLOBAL

 +1        SET (AUMDO("PAGE #"),AUMDO("QUIT"),AUMDO("ICD0"),AUMDO("ICD9"))=0

 +2       ; SET ICD FILE FLAG

           SET AUMDO(AUMDO("ICD FILE"))=1

 +3       ; CHECK TO SEE IF THERE IS AN UPDATE GLOBAL

 +4        IF $DATA(@$SELECT(AUMDO("ICD0"):"^AUMDOTMP",AUMDO("ICD9"):"^AUMDDTMP"))

 +5       ; SET QUIT FLAG

          IF '$TEST

               WRITE "AUMDO - **** Update global file ^AUMDO"_$SELECT(AUMDO("ICD0"):"OP",AUMDO("ICD9"):"DX")_"U does not exist! ****",!,?10,"**** "_AUMDO("ICD FILE")_" update not performed. ****",!!

               SET AUMDO("QUIT")=1

               QUIT 

 +6        SET $PIECE(AUMDO("DASHES"),"-",80)=""

 +7        SET AUMDO("UPD GL REF")=$SELECT(AUMDO("ICD0"):"^AUMDOTMP(",AUMDO("ICD9"):"^AUMDDTMP(")

 +8        SET AUMDO("ICD GL REF")=$SELECT(AUMDO("ICD0"):"^ICD0(",AUMDO("ICD9"):"^ICD9(")

 +9        SET AUMDO("DLAYGO ICD")=$SELECT(AUMDO("ICD0"):80.1,AUMDO("ICD9"):80)

 +10       SET AUMDO("DLAYGO DRG")=$SELECT(AUMDO("ICD0"):80.11,AUMDO("ICD9"):80.01)

 +11       SET AUMDO("DLAYGO MDC")=80.12

 +12       SET AUMDO("DLAYGO KWD")=$SELECT(AUMDO("ICD0"):"80.1999999921",AUMDO("ICD9"):"80.999999921")

 +13       SET AUMDO("DIC(P) DRG")=$SELECT(AUMDO("ICD0"):"^DD(80.1,6,0)",AUMDO("ICD9"):"^DD(80,6,0)")

 +14       SET AUMDO("DIC(P) KWD")=$SELECT(AUMDO("ICD0"):"^DD(80.1,9999999.21,0)",AUMDO("ICD9"):"^DD(80,9999999.21,0)")

 +15       SET AUMDO("DIC(P) MDC")="^DD(80.1,7,0)"

 +16       SET AUMDO("ICD CODE")=9999999

 +17      ; SET COUNTERS AND START $O VALUE

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

 +18      ; PRINT HEADING

           DO HDR

 +19       QUIT 

CLEANUP   ; KILL AUMDO* QUIT GRACEFULLY

 +1        KILL AUMDO

 +2        DO ^%ZISC

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4        QUIT 

HDR       ; ENTRY POINT FROM MULTIPLE POINTS IN ^AUMDO1,^AUMDO1A,^AUMDO1B,^AUMDO1BS,^AUMDO1C TO PRINT PAGE HEADINGS

 +1        SET AUMDO("PAGE #")=AUMDO("PAGE #")+1

 +2       ; GET DATE/TIME

           DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

 +3        SET AUMDO("DATE")=$PIECE(Y,"@")

           SET AUMDO("TIME")=$EXTRACT($PIECE(Y,"@",2),1,5)

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE AUMDO("DASHES"),!

 +6        WRITE ?5,"I C D "_$EXTRACT(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"),!

 +7        QUIT