- 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 Mar 13, 2025@21:44:26 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
