SRHLDW1 ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for Files ; [ 06/11/98 6:17 AM ]
;;3.0;Surgery;**41,177**;24 Jun 93;Build 89
;
N CNT,OUT,SRTYP
;Interface Files (1st 3 letter must be unique for the TMP global)
S CNT(1)="CPT4^81"
S CNT(2)="ICD^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 file's 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,icd,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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLDW1 1590 printed Nov 22, 2024@17:49:13 Page 2
SRHLDW1 ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for Files ; [ 06/11/98 6:17 AM ]
+1 ;;3.0;Surgery;**41,177**;24 Jun 93;Build 89
+2 ;
+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)="ICD^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 file's 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,icd,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
