- SROAMIS ;BIR/MAM - ANESTHESIA AMIS REPORT ;11/26/07
- ;;3.0; Surgery ;**22,34,38,77,50,86,166**;24 Jun 93;Build 6
- UTL ; set up ^TMP("SROAMIS",$J
- S PRIN=$P($G(^SRF(SRDFN,.3)),"^",8) I PRIN="" S PRIN="O"
- S PROC=$S($D(^SRF(SRDFN,31)):$P(^(31),"^",9),1:""),DEATH=""
- S:PRIN="O" TECH="L" I TECH="L",PRIN'="O" S TECH="O"
- S S(0)=^SRF(SRDFN,0),DFN=$P(S(0),"^") S DEATH=$S('$D(^DPT(DFN,.35)):"",$P(^DPT(DFN,.35),"^")="":"",1:$P(^(.35),"^"))
- I +DEATH S:$D(^TMP("SRTN",$J,DFN)) DEATH="" I +DEATH D DEAD
- S $P(^TMP("SROAMIS",$J,"T",TECH),"^")=^TMP("SROAMIS",$J,"T",TECH)+1 I DEATH'="" S $P(^(TECH),"^",2)=$P(^(TECH),"^",2)+1
- I PROC'="Y" S $P(^TMP("SROAMIS",$J,"P","SURG",PRIN),"^")=$P(^TMP("SROAMIS",$J,"P","SURG",PRIN),"^")+1 S:DEATH'="" $P(^(PRIN),"^",2)=$P(^(PRIN),"^",2)+1
- I PROC="Y" S $P(^TMP("SROAMIS",$J,"P","DIAG",PRIN),"^")=$P(^TMP("SROAMIS",$J,"P","DIAG",PRIN),"^")+1 S:DEATH'="" $P(^(PRIN),"^",2)=$P(^(PRIN),"^",2)+1
- Q
- SET ; get anesthesia info from ^SRF(SRDFN,6
- K SRTECH S (SRCNT,SRT,SRZ)=0,SRTN=SRDFN F S SRT=$O(^SRF(SRDFN,6,SRT)) Q:SRT=""!(SRZ) D ^SROPRIN S SRCNT=SRCNT+1
- I '$D(SRTECH),SRCNT=1 S SRT=$O(^SRF(SRTN,6,0)),SRTECH=$P(^SRF(SRTN,6,SRT,0),"^")
- K SRTN I $D(SRTECH) Q:SRTECH="N" S TECH=SRTECH D UTL
- Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
- W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?57,"ANESTHESIA SERVICE",?100,"REVIEWED BY: ",!,?58,"ANESTHESIA AMIS",?100,"DATE REVIEWED: "
- W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
- W !!!!! F I=1:1:IOM W "="
- W !,?38,"ANESTHETICS ADMINISTERED BY PRINCIPAL TECHNIQUE USED",! F I=1:1:IOM W "-"
- W !,"TOTAL NO OF ANES- | | | | | |"
- W !,"THETICS ADMINISTERED | GENERAL | MAC | SPINAL | EPIDURAL | OTHER | LOCAL",! F I=1:1:IOM W "-"
- Q
- END W:$E(IOST)="P" @IOF K ^TMP("SROAMIS",$J),^TMP("SRTN",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
- D ^%ZISC,^SRSKILL W @IOF
- Q
- DEAD ; check for death within 24 hrs.
- S OPDATE=$S($D(^SRF(SRDFN,.2)):$P(^(.2),"^"),1:"") S:OPDATE="" OPDATE=$P(^SRF(SRDFN,0),"^",9) S X1=OPDATE,X2=1 D C^%DTC S OPONE=X S DEATH=$S(DEATH<(OPONE+.0001):1,1:"")
- I DEATH S ^TMP("SRTN",$J,DFN)=""
- Q
- EN ; entry for SROAMIS option
- W @IOF,!,"Anesthesia AMIS",!!,"This report is no longer available.",!
- K DIR S DIR(0)="E" D ^DIR K DIR D END
- Q
- DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END S SRD=SDATE-.0001
- N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))
- W !!!,"This report is designed to use a 132 column format, and must be run",!,"on a printer.",!!
- PTR K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Select Printer: ",%ZIS="QM" D ^%ZIS G:POP END W:$E(IOST)'="P" !!,"This report must be run on a printer.",!! G:$E(IOST)'="P" PTR
- I $D(IO("Q")) K IO("Q") S ZTDESC="ANESTHESIA AMIS",ZTRTN="1^SROAMIS",(ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRD"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"))="" D ^%ZTLOAD G END
- 1 ; entry when queued
- U IO N SRFRTO K ^TMP("SROAMIS",$J),^TMP("SRTN",$J) S SRSOUT=0,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y
- S Y=SDATE X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=EDATE X ^DD("DD") S SRFRTO=SRFRTO_Y
- F I="G","M","S","E","O","L" S ^TMP("SROAMIS",$J,"T",I)=0 F I="A","N","O" S ^TMP("SROAMIS",$J,"P","DIAG",I)=0,^TMP("SROAMIS",$J,"P","SURG",I)=0 K I
- S SRDFN=0,Z=SRD F S Z=$O(^SRF("AC",Z)) Q:Z>(EDATE+.9999)!(Z="") F S SRDFN=$O(^SRF("AC",Z,SRDFN)) Q:SRDFN="" D
- .I $D(^SRF(SRDFN,0)),$P($G(^SRF(SRDFN,.2)),"^",12)'=""!($P($G(^SRF(SRDFN,"NON")),"^")="Y"),$$MANDIV^SROUTL0(SRINSTP,SRDFN) D SET
- D HDR G:SRSOUT END D PRINT^SROAMIS1
- G END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAMIS 3698 printed Jan 18, 2025@03:42:16 Page 2
- SROAMIS ;BIR/MAM - ANESTHESIA AMIS REPORT ;11/26/07
- +1 ;;3.0; Surgery ;**22,34,38,77,50,86,166**;24 Jun 93;Build 6
- UTL ; set up ^TMP("SROAMIS",$J
- +1 SET PRIN=$PIECE($GET(^SRF(SRDFN,.3)),"^",8)
- IF PRIN=""
- SET PRIN="O"
- +2 SET PROC=$SELECT($DATA(^SRF(SRDFN,31)):$PIECE(^(31),"^",9),1:"")
- SET DEATH=""
- +3 if PRIN="O"
- SET TECH="L"
- IF TECH="L"
- IF PRIN'="O"
- SET TECH="O"
- +4 SET S(0)=^SRF(SRDFN,0)
- SET DFN=$PIECE(S(0),"^")
- SET DEATH=$SELECT('$DATA(^DPT(DFN,.35)):"",$PIECE(^DPT(DFN,.35),"^")="":"",1:$PIECE(^(.35),"^"))
- +5 IF +DEATH
- if $DATA(^TMP("SRTN",$JOB,DFN))
- SET DEATH=""
- IF +DEATH
- DO DEAD
- +6 SET $PIECE(^TMP("SROAMIS",$JOB,"T",TECH),"^")=^TMP("SROAMIS",$JOB,"T",TECH)+1
- IF DEATH'=""
- SET $PIECE(^(TECH),"^",2)=$PIECE(^(TECH),"^",2)+1
- +7 IF PROC'="Y"
- SET $PIECE(^TMP("SROAMIS",$JOB,"P","SURG",PRIN),"^")=$PIECE(^TMP("SROAMIS",$JOB,"P","SURG",PRIN),"^")+1
- if DEATH'=""
- SET $PIECE(^(PRIN),"^",2)=$PIECE(^(PRIN),"^",2)+1
- +8 IF PROC="Y"
- SET $PIECE(^TMP("SROAMIS",$JOB,"P","DIAG",PRIN),"^")=$PIECE(^TMP("SROAMIS",$JOB,"P","DIAG",PRIN),"^")+1
- if DEATH'=""
- SET $PIECE(^(PRIN),"^",2)=$PIECE(^(PRIN),"^",2)+1
- +9 QUIT
- SET ; get anesthesia info from ^SRF(SRDFN,6
- +1 KILL SRTECH
- SET (SRCNT,SRT,SRZ)=0
- SET SRTN=SRDFN
- FOR
- SET SRT=$ORDER(^SRF(SRDFN,6,SRT))
- if SRT=""!(SRZ)
- QUIT
- DO ^SROPRIN
- SET SRCNT=SRCNT+1
- +2 IF '$DATA(SRTECH)
- IF SRCNT=1
- SET SRT=$ORDER(^SRF(SRTN,6,0))
- SET SRTECH=$PIECE(^SRF(SRTN,6,SRT,0),"^")
- +3 KILL SRTN
- IF $DATA(SRTECH)
- if SRTECH="N"
- QUIT
- SET TECH=SRTECH
- DO UTL
- +4 QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 if $Y
- WRITE @IOF
- WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,!,?57,"ANESTHESIA SERVICE",?100,"REVIEWED BY: ",!,?58,"ANESTHESIA AMIS",?100,"DATE REVIEWED: "
- +3 WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,SRPRINT
- +4 WRITE !!!!!
- FOR I=1:1:IOM
- WRITE "="
- +5 WRITE !,?38,"ANESTHETICS ADMINISTERED BY PRINCIPAL TECHNIQUE USED",!
- FOR I=1:1:IOM
- WRITE "-"
- +6 WRITE !,"TOTAL NO OF ANES- | | | | | |"
- +7 WRITE !,"THETICS ADMINISTERED | GENERAL | MAC | SPINAL | EPIDURAL | OTHER | LOCAL",!
- FOR I=1:1:IOM
- WRITE "-"
- +8 QUIT
- END if $EXTRACT(IOST)="P"
- WRITE @IOF
- KILL ^TMP("SROAMIS",$JOB),^TMP("SRTN",$JOB)
- IF $DATA(ZTQUEUED)
- if $GET(ZTSTOP)
- QUIT
- SET ZTREQ="@"
- QUIT
- +1 DO ^%ZISC
- DO ^SRSKILL
- WRITE @IOF
- +2 QUIT
- DEAD ; check for death within 24 hrs.
- +1 SET OPDATE=$SELECT($DATA(^SRF(SRDFN,.2)):$PIECE(^(.2),"^"),1:"")
- if OPDATE=""
- SET OPDATE=$PIECE(^SRF(SRDFN,0),"^",9)
- SET X1=OPDATE
- SET X2=1
- DO C^%DTC
- SET OPONE=X
- SET DEATH=$SELECT(DEATH<(OPONE+.0001):1,1:"")
- +2 IF DEATH
- SET ^TMP("SRTN",$JOB,DFN)=""
- +3 QUIT
- EN ; entry for SROAMIS option
- +1 WRITE @IOF,!,"Anesthesia AMIS",!!,"This report is no longer available.",!
- +2 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- DO END
- +3 QUIT
- DATE DO DATE^SROUTL(.SDATE,.EDATE,.SRSOUT)
- if SRSOUT
- GOTO END
- SET SRD=SDATE-.0001
- +1 NEW SRINSTP
- SET SRINST=$$INST^SROUTL0()
- if SRINST="^"
- GOTO END
- SET SRINSTP=$PIECE(SRINST,U)
- SET SRINST=$SELECT(SRINST["ALL DIVISIONS":SRINST,1:$PIECE(SRINST,U,2))
- +2 WRITE !!!,"This report is designed to use a 132 column format, and must be run",!,"on a printer.",!!
- PTR KILL IOP,%ZIS,POP,IO("Q")
- SET %ZIS("A")="Select Printer: "
- SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO END
- if $EXTRACT(IOST)'="P"
- WRITE !!,"This report must be run on a printer.",!!
- if $EXTRACT(IOST)'="P"
- GOTO PTR
- +1 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTDESC="ANESTHESIA AMIS"
- SET ZTRTN="1^SROAMIS"
- SET (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRD"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"))=""
- DO ^%ZTLOAD
- GOTO END
- 1 ; entry when queued
- +1 USE IO
- NEW SRFRTO
- KILL ^TMP("SROAMIS",$JOB),^TMP("SRTN",$JOB)
- SET SRSOUT=0
- SET Y=DT
- XECUTE ^DD("DD")
- SET SRPRINT="DATE PRINTED: "_Y
- +2 SET Y=SDATE
- XECUTE ^DD("DD")
- SET SRFRTO="FROM: "_Y_" TO: "
- SET Y=EDATE
- XECUTE ^DD("DD")
- SET SRFRTO=SRFRTO_Y
- +3 FOR I="G","M","S","E","O","L"
- SET ^TMP("SROAMIS",$JOB,"T",I)=0
- FOR I="A","N","O"
- SET ^TMP("SROAMIS",$JOB,"P","DIAG",I)=0
- SET ^TMP("SROAMIS",$JOB,"P","SURG",I)=0
- KILL I
- +4 SET SRDFN=0
- SET Z=SRD
- FOR
- SET Z=$ORDER(^SRF("AC",Z))
- if Z>(EDATE+.9999)!(Z="")
- QUIT
- FOR
- SET SRDFN=$ORDER(^SRF("AC",Z,SRDFN))
- if SRDFN=""
- QUIT
- Begin DoDot:1
- +5 IF $DATA(^SRF(SRDFN,0))
- IF $PIECE($GET(^SRF(SRDFN,.2)),"^",12)'=""!($PIECE($GET(^SRF(SRDFN,"NON")),"^")="Y")
- IF $$MANDIV^SROUTL0(SRINSTP,SRDFN)
- DO SET
- End DoDot:1
- +6 DO HDR
- if SRSOUT
- GOTO END
- DO PRINT^SROAMIS1
- +7 GOTO END