Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/SURGERY-SR/SROAMIS.m

    r613 r623  
    1 SROAMIS ;BIR/MAM - ANESTHESIA AMIS REPORT ;11/26/07
    2         ;;3.0; Surgery ;**22,34,38,77,50,86,166**;24 Jun 93;Build 7
    3 UTL     ; set up ^TMP("SROAMIS",$J
    4         S PRIN=$P($G(^SRF(SRDFN,.3)),"^",8) I PRIN="" S PRIN="O"
    5         S PROC=$S($D(^SRF(SRDFN,31)):$P(^(31),"^",9),1:""),DEATH=""
    6         S:PRIN="O" TECH="L" I TECH="L",PRIN'="O" S TECH="O"
    7         S S(0)=^SRF(SRDFN,0),DFN=$P(S(0),"^") S DEATH=$S('$D(^DPT(DFN,.35)):"",$P(^DPT(DFN,.35),"^")="":"",1:$P(^(.35),"^"))
    8         I +DEATH S:$D(^TMP("SRTN",$J,DFN)) DEATH="" I +DEATH D DEAD
    9         S $P(^TMP("SROAMIS",$J,"T",TECH),"^")=^TMP("SROAMIS",$J,"T",TECH)+1 I DEATH'="" S $P(^(TECH),"^",2)=$P(^(TECH),"^",2)+1
    10         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
    11         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
    12         Q
    13 SET     ; get anesthesia info from ^SRF(SRDFN,6
    14         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
    15         I '$D(SRTECH),SRCNT=1 S SRT=$O(^SRF(SRTN,6,0)),SRTECH=$P(^SRF(SRTN,6,SRT,0),"^")
    16         K SRTN I $D(SRTECH) Q:SRTECH="N"  S TECH=SRTECH D UTL
    17         Q
    18 HDR     ; print heading
    19         I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
    20         W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?57,"ANESTHESIA SERVICE",?100,"REVIEWED BY: ",!,?58,"ANESTHESIA AMIS",?100,"DATE REVIEWED: "
    21         W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
    22         W !!!!! F I=1:1:IOM W "="
    23         W !,?38,"ANESTHETICS ADMINISTERED BY PRINCIPAL TECHNIQUE USED",! F I=1:1:IOM W "-"
    24         W !,"TOTAL NO OF ANES-       |             |             |             |             |             |"
    25         W !,"THETICS ADMINISTERED    |   GENERAL   |   MAC       |   SPINAL    |   EPIDURAL  |   OTHER     |   LOCAL",! F I=1:1:IOM W "-"
    26         Q
    27 END     W:$E(IOST)="P" @IOF K ^TMP("SROAMIS",$J),^TMP("SRTN",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q
    28         D ^%ZISC,^SRSKILL W @IOF
    29         Q
    30 DEAD    ; check for death within 24 hrs.
    31         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:"")
    32         I DEATH S ^TMP("SRTN",$J,DFN)=""
    33         Q
    34 EN      ; entry for SROAMIS option
    35         W @IOF,!,"Anesthesia AMIS",!!,"This report is no longer available.",!
    36         K DIR S DIR(0)="E" D ^DIR K DIR D END
    37         Q
    38 DATE    D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END S SRD=SDATE-.0001
    39         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))
    40         W !!!,"This report is designed to use a 132 column format, and must be run",!,"on a printer.",!!
    41 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
    42         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
    43 1       ; entry when queued
    44         U IO N SRFRTO K ^TMP("SROAMIS",$J),^TMP("SRTN",$J) S SRSOUT=0,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y
    45         S Y=SDATE X ^DD("DD") S SRFRTO="FROM: "_Y_"  TO: ",Y=EDATE X ^DD("DD") S SRFRTO=SRFRTO_Y
    46         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
    47         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
    48         .I $D(^SRF(SRDFN,0)),$P($G(^SRF(SRDFN,.2)),"^",12)'=""!($P($G(^SRF(SRDFN,"NON")),"^")="Y"),$$MANDIV^SROUTL0(SRINSTP,SRDFN) D SET
    49         D HDR G:SRSOUT END D PRINT^SROAMIS1
    50         G END
     1SROAMIS ;B'HAM ISC/MAM - ANESTHESIA AMIS REPORT ; [ 12/16/98  2:06 PM ]
     2 ;;3.0; Surgery ;**22,34,38,77,50,86**;24 Jun 93
     3UTL ; set up ^TMP("SROAMIS",$J
     4 S PRIN=$P($G(^SRF(SRDFN,.3)),"^",8) I PRIN="" S PRIN="O"
     5 S PROC=$S($D(^SRF(SRDFN,31)):$P(^(31),"^",9),1:""),DEATH=""
     6 S:PRIN="O" TECH="L" I TECH="L",PRIN'="O" S TECH="O"
     7 S S(0)=^SRF(SRDFN,0),DFN=$P(S(0),"^") S DEATH=$S('$D(^DPT(DFN,.35)):"",$P(^DPT(DFN,.35),"^")="":"",1:$P(^(.35),"^"))
     8 I +DEATH S:$D(^TMP("SRTN",$J,DFN)) DEATH="" I +DEATH D DEAD
     9 S $P(^TMP("SROAMIS",$J,"T",TECH),"^")=^TMP("SROAMIS",$J,"T",TECH)+1 I DEATH'="" S $P(^(TECH),"^",2)=$P(^(TECH),"^",2)+1
     10 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
     11 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
     12 Q
     13SET ; get anesthesia info from ^SRF(SRDFN,6
     14 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
     15 I '$D(SRTECH),SRCNT=1 S SRT=$O(^SRF(SRTN,6,0)),SRTECH=$P(^SRF(SRTN,6,SRT,0),"^")
     16 K SRTN I $D(SRTECH) Q:SRTECH="N"  S TECH=SRTECH D UTL
     17 Q
     18HDR ; print heading
     19 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
     20 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?57,"ANESTHESIA SERVICE",?100,"REVIEWED BY: ",!,?58,"ANESTHESIA AMIS",?100,"DATE REVIEWED: "
     21 W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
     22 W !!!!! F I=1:1:IOM W "="
     23 W !,?38,"ANESTHETICS ADMINISTERED BY PRINCIPAL TECHNIQUE USED",! F I=1:1:IOM W "-"
     24 W !,"TOTAL NO OF ANES-       |             |             |             |             |             |"
     25 W !,"THETICS ADMINISTERED    |   GENERAL   |   MAC       |   SPINAL    |   EPIDURAL  |   OTHER     |   LOCAL",! F I=1:1:IOM W "-"
     26 Q
     27END W:$E(IOST)="P" @IOF K ^TMP("SROAMIS",$J),^TMP("SRTN",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q
     28 D ^%ZISC,^SRSKILL W @IOF
     29 Q
     30DEAD ; check for death within 24 hrs.
     31 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:"")
     32 I DEATH S ^TMP("SRTN",$J,DFN)=""
     33 Q
     34EN ; entry for SROAMIS option
     35 W @IOF,!,"Anesthesia AMIS",!
     36DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END S SRD=SDATE-.0001
     37 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))
     38 W !!!,"This report is designed to use a 132 column format, and must be run",!,"on a printer.",!!
     39PTR 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
     40 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
     411 ; entry when queued
     42 U IO N SRFRTO K ^TMP("SROAMIS",$J),^TMP("SRTN",$J) S SRSOUT=0,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y
     43 S Y=SDATE X ^DD("DD") S SRFRTO="FROM: "_Y_"  TO: ",Y=EDATE X ^DD("DD") S SRFRTO=SRFRTO_Y
     44 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
     45 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
     46 .I $D(^SRF(SRDFN,0)),$P($G(^SRF(SRDFN,.2)),"^",12)'=""!($P($G(^SRF(SRDFN,"NON")),"^")="Y"),$$MANDIV^SROUTL0(SRINSTP,SRDFN) D SET
     47 D HDR G:SRSOUT END D PRINT^SROAMIS1
     48 G END
Note: See TracChangeset for help on using the changeset viewer.