SRHLDW1.m

SRHLDW1 ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for Files ; [ 06/11/98  6:17 AM ]

 ;;3.0; Surgery ;**41**;24 Jun 93

 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 N CNT,OUT,SRTYP

 ;Interface Files (1st 3 letter must be unique for the TMP global)

 S CNT(1)="CPT4^81"

 S CNT(2)="ICD9^80"

 S CNT(3)="MEDICATION^50"

 S CNT(4)="MONITOR^133.4"

 S CNT(5)="PERSONNEL^200"

 S CNT(6)="REPLACEMENT FLUID^133.7"

 S CNT(7)="ANES SUPERVISE CODE^132.95"

 S CNT(8)="LOCATION^44"

 F  W @IOF S (OUT,SRTYP)=0 D HDR Q:$G(OUT)=1  D ASK

 W @IOF

END D KDIR Q

HDR ;header for the OBR Menu

 N HDR,SRX,C

 S HDR="Surgery Interface File Download Option" W ?((IOM-$L(HDR))/2),HDR,!!

 S SRX=0 F  S SRX=$O(CNT(SRX)) Q:'SRX  S C=$G(C)+1 W !,SRX,".  ",$P(CNT(SRX),"^")

 W ! D KDIR S DIR(0)="NO^1:"_C,DIR("A")="Enter file to Capture",DIR("?")="Enter the files corresponding number" D ^DIR S:$D(DIRUT) OUT=1 I '$D(DIRUT) D KDIR S SRTYP=Y

 Q

ASK ;

 N G

 S DIR(0)="YO",DIR("B")="YES",DIR("A")="Update the "_$P(CNT(SRTYP),U)_" file",DIR("B")="YES" D ^DIR I $D(DIRUT)!(Y=0) S OUT=1 Q

 I $P(CNT(SRTYP),U)="CPT4" W !,"NOT AVAILABLE" Q

 W !,"Queuing message" S ZTDTH=$H,ZTIO="",ZTDESC=$P(CNT(SRTYP),U)_" Master File Update.",ZTRTN="ENQ^SRHLDW1"

 F G="SRTYP","CNT("_SRTYP_")" S:$D(@G) ZTSAVE(G)=""

 D ^%ZTLOAD

 Q

ENQ ;

 N FEC,REC,SRENT,SRTBL

 S SRENT="",FEC="REP",REC="MAD",SRTBL=CNT(SRTYP)

 ;cpt4,icd9,medication,monitor,personnel,replacement fluid,anes super code,location

 D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)

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

 Q

KDIR ;kills all DIR variables

 K DIR,DIRUT,DUOUT,DTOUT,DIROUT

 Q

SRHLDW1   ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for Files ; [ 06/11/98  6:17 AM ]

 +1       ;;3.0; Surgery ;**41**;24 Jun 93

 +2       ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 +3        NEW CNT,OUT,SRTYP

 +4       ;Interface Files (1st 3 letter must be unique for the TMP global)

 +5        SET CNT(1)="CPT4^81"

 +6        SET CNT(2)="ICD9^80"

 +7        SET CNT(3)="MEDICATION^50"

 +8        SET CNT(4)="MONITOR^133.4"

 +9        SET CNT(5)="PERSONNEL^200"

 +10       SET CNT(6)="REPLACEMENT FLUID^133.7"

 +11       SET CNT(7)="ANES SUPERVISE CODE^132.95"

 +12       SET CNT(8)="LOCATION^44"

 +13       FOR 

               WRITE @IOF

               SET (OUT,SRTYP)=0

               DO HDR

               IF $GET(OUT)=1

                   QUIT 

               DO ASK

 +14       WRITE @IOF

END        DO KDIR

           QUIT 

HDR       ;header for the OBR Menu

 +1        NEW HDR,SRX,C

 +2        SET HDR="Surgery Interface File Download Option"

           WRITE ?((IOM-$LENGTH(HDR))/2),HDR,!!

 +3        SET SRX=0

           FOR 

               SET SRX=$ORDER(CNT(SRX))

               IF 'SRX

                   QUIT 

               SET C=$GET(C)+1

               WRITE !,SRX,".  ",$PIECE(CNT(SRX),"^")

 +4        WRITE !

           DO KDIR

           SET DIR(0)="NO^1:"_C

           SET DIR("A")="Enter file to Capture"

           SET DIR("?")="Enter the files corresponding number"

           DO ^DIR

           IF $DATA(DIRUT)

               SET OUT=1

           IF '$DATA(DIRUT)

               DO KDIR

               SET SRTYP=Y

 +5        QUIT 

ASK       ;

 +1        NEW G

 +2        SET DIR(0)="YO"

           SET DIR("B")="YES"

           SET DIR("A")="Update the "_$PIECE(CNT(SRTYP),U)_" file"

           SET DIR("B")="YES"

           DO ^DIR

           IF $DATA(DIRUT)!(Y=0)

               SET OUT=1

               QUIT 

 +3        IF $PIECE(CNT(SRTYP),U)="CPT4"

               WRITE !,"NOT AVAILABLE"

               QUIT 

 +4        WRITE !,"Queuing message"

           SET ZTDTH=$HOROLOG

           SET ZTIO=""

           SET ZTDESC=$PIECE(CNT(SRTYP),U)_" Master File Update."

           SET ZTRTN="ENQ^SRHLDW1"

 +5        FOR G="SRTYP","CNT("_SRTYP_")"

               IF $DATA(@G)

                   SET ZTSAVE(G)=""

 +6        DO ^%ZTLOAD

 +7        QUIT 

ENQ       ;

 +1        NEW FEC,REC,SRENT,SRTBL

 +2        SET SRENT=""

           SET FEC="REP"

           SET REC="MAD"

           SET SRTBL=CNT(SRTYP)

 +3       ;cpt4,icd9,medication,monitor,personnel,replacement fluid,anes super code,location

 +4        DO MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)

 +5        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +6        QUIT 

KDIR      ;kills all DIR variables

 +1        KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT

 +2        QUIT