- SROQIDP0 ;BIR/ADM - LIST OF INVASIVE DIAGNOSTIC PROCEDURES ;09/22/98 11:46 AM
- ;;3.0; Surgery ;**62,77,50,142**;24 Jun 93
- ;
- ;** NOTICE: This routine is part of an implementation of a nationally
- ;** controlled procedure. Local modifications to this routine
- ;** are prohibited.
- ;
- U IO S (SRIDPT,SRSOUT)=0,(SRHDR,SRPAGE)=1,SRSD=SDATE-.0001,SRED=EDATE+.9999,Y=SDATE X ^DD("DD") S STARTDT=Y,Y=EDATE X ^DD("DD") S ENDATE=Y K ^TMP("SR",$J) F I="N","I","O" S SRIOT(I)=0
- S SRRPT="LIST OF INVASIVE DIAGNOSTIC PROCEDURES",SRFRTO="From: "_STARTDT_" To: "_ENDATE
- S SRINST=$S(SRINSTP["ALL DIV":$P($$SITE^SROVAR,"^",2)_" - ALL DIVISIONS",1:$$GET1^DIQ(4,SRINSTP,.01))
- D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S SRPRINT="Report Printed: "_Y
- D HDR D AC^SROQIDP
- I SRIDPT=0 W $$NODATA^SROUTL0() Q
- S SRSD=0 F S SRSD=$O(^TMP("SR",$J,SRSD)) Q:'SRSD!SRSOUT S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SRSD,SRTN)) Q:'SRTN!SRSOUT S SRZ=^TMP("SR",$J,SRSD,SRTN) D PRINT
- D:$Y+10>IOSL PAGE Q:SRSOUT W !! D
- .I SRIO="A" W ?4,"TOTAL CASES BY IN/OUT-PATIENT STATUS",!,?14,"INPATIENT: ",SRIOT("I"),!,?13,"OUTPATIENT: ",SRIOT("O"),!,?12,"NOT ENTERED: ",SRIOT("N"),!!,?12,"TOTAL CASES: ",SRIDPT
- .I SRIO'="A" W "TOTAL "_$S(SRIO="I":"INPATIENT",1:"OUTPATIENT")_" CASES: "_SRIOT(SRIO)
- Q
- PRINT ; print case information
- D:$Y+9>IOSL PAGE Q:SRSOUT S SRL=78,SRSUPCPT=1 D PROC^SROUTL
- S DFN=$P(SRZ,"^"),SRSS=$P(^SRO(137.45,$P(SRZ,"^",2),0),"^"),Y=$P(SRZ,"^",3),SRIOSTAT=$S(Y="I":"INPATIENT",Y="O":"OUTPATIENT",1:"NOT ENTERED"),SRDOC=$P($G(^SRF(SRTN,.1)),"^",4) I SRDOC S SRDOC=$P(^VA(200,SRDOC,0),"^")
- D DEM^VADPT S SRSNM=VADM(1),SRSSN=VA("PID"),Y=SRSD X ^DD("DD") S SRSDATE=Y,X1=$E(SRSD,1,7),X2=$P(VADM(3),"^"),SRAGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7))
- D TECH^SROPRIN S SRANES=$S(SRTECH'="":SRTECH,1:"NOT ENTERED")
- W !,SRSDATE,?22,SRSNM,?54,$S(SRSPEC:$E(SRDOC,1,27),1:$E(SRSS,1,27)),?89,SRANES,?117,SRIOSTAT
- W !,SRTN,?22,SRSSN_" ("_SRAGE_")",?54,SRPROC(1),! S I=1 F S I=$O(SRPROC(I)) Q:'I W ?54,SRPROC(I),!
- D:$Y+9>IOSL PAGE Q:SRSOUT S SRL=78 D PROC^SROUTLN W !,?54,SRPROC(1),! S I=1 F S I=$O(SRPROC(I)) Q:'I W ?54,SRPROC(I),!
- Q
- PRESS W !! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
- Q
- PAGE I $E(IOST)="P"!SRHDR G HDR
- D PRESS I SRSOUT Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
- W:$Y @IOF W:$E(IOST)="P" !,?(IOM-$L(SRINST)\2),SRINST W !,?(IOM-$L(SRRPT)\2),SRRPT,?(IOM-10),$J("PAGE "_SRPAGE,9),!,?(IOM-$L(SRFRTO)\2),SRFRTO W:$E(IOST)="P" !,?(IOM-$L(SRPRINT)\2),SRPRINT
- I SRSPEC S X="SURGICAL SPECIALTY: "_SRSPECN W !,?(IOM-$L(X)\2),X
- W !!,"DATE OF OPERATION",?22,"PATIENT NAME",?54,$S(SRSPEC:"SURGEON",1:"SURGICAL SPECIALTY"),?89,"ANESTHESIA TECHNIQUE",?117,"IN/OUT-PATIENT"
- W !,"CASE #",?22,"PATIENT ID (AGE)",?54,"PROCEDURE(S) PERFORMED"
- S SRHDR=0,SRPAGE=SRPAGE+1 W ! F I=1:1:IOM W "="
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROQIDP0 2889 printed Feb 19, 2025@00:12 Page 2
- SROQIDP0 ;BIR/ADM - LIST OF INVASIVE DIAGNOSTIC PROCEDURES ;09/22/98 11:46 AM
- +1 ;;3.0; Surgery ;**62,77,50,142**;24 Jun 93
- +2 ;
- +3 ;** NOTICE: This routine is part of an implementation of a nationally
- +4 ;** controlled procedure. Local modifications to this routine
- +5 ;** are prohibited.
- +6 ;
- +7 USE IO
- SET (SRIDPT,SRSOUT)=0
- SET (SRHDR,SRPAGE)=1
- SET SRSD=SDATE-.0001
- SET SRED=EDATE+.9999
- SET Y=SDATE
- XECUTE ^DD("DD")
- SET STARTDT=Y
- SET Y=EDATE
- XECUTE ^DD("DD")
- SET ENDATE=Y
- KILL ^TMP("SR",$JOB)
- FOR I="N","I","O"
- SET SRIOT(I)=0
- +8 SET SRRPT="LIST OF INVASIVE DIAGNOSTIC PROCEDURES"
- SET SRFRTO="From: "_STARTDT_" To: "_ENDATE
- +9 SET SRINST=$SELECT(SRINSTP["ALL DIV":$PIECE($$SITE^SROVAR,"^",2)_" - ALL DIVISIONS",1:$$GET1^DIQ(4,SRINSTP,.01))
- +10 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- SET SRPRINT="Report Printed: "_Y
- +11 DO HDR
- DO AC^SROQIDP
- +12 IF SRIDPT=0
- WRITE $$NODATA^SROUTL0()
- QUIT
- +13 SET SRSD=0
- FOR
- SET SRSD=$ORDER(^TMP("SR",$JOB,SRSD))
- if 'SRSD!SRSOUT
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SR",$JOB,SRSD,SRTN))
- if 'SRTN!SRSOUT
- QUIT
- SET SRZ=^TMP("SR",$JOB,SRSD,SRTN)
- DO PRINT
- +14 if $Y+10>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- WRITE !!
- Begin DoDot:1
- +15 IF SRIO="A"
- WRITE ?4,"TOTAL CASES BY IN/OUT-PATIENT STATUS",!,?14,"INPATIENT: ",SRIOT("I"),!,?13,"OUTPATIENT: ",SRIOT("O"),!,?12,"NOT ENTERED: ",SRIOT("N"),!!,?12,"TOTAL CASES: ",SRIDPT
- +16 IF SRIO'="A"
- WRITE "TOTAL "_$SELECT(SRIO="I":"INPATIENT",1:"OUTPATIENT")_" CASES: "_SRIOT(SRIO)
- End DoDot:1
- +17 QUIT
- PRINT ; print case information
- +1 if $Y+9>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- SET SRL=78
- SET SRSUPCPT=1
- DO PROC^SROUTL
- +2 SET DFN=$PIECE(SRZ,"^")
- SET SRSS=$PIECE(^SRO(137.45,$PIECE(SRZ,"^",2),0),"^")
- SET Y=$PIECE(SRZ,"^",3)
- SET SRIOSTAT=$SELECT(Y="I":"INPATIENT",Y="O":"OUTPATIENT",1:"NOT ENTERED")
- SET SRDOC=$PIECE($GET(^SRF(SRTN,.1)),"^",4)
- IF SRDOC
- SET SRDOC=$PIECE(^VA(200,SRDOC,0),"^")
- +3 DO DEM^VADPT
- SET SRSNM=VADM(1)
- SET SRSSN=VA("PID")
- SET Y=SRSD
- XECUTE ^DD("DD")
- SET SRSDATE=Y
- SET X1=$EXTRACT(SRSD,1,7)
- SET X2=$PIECE(VADM(3),"^")
- SET SRAGE=$EXTRACT(X1,1,3)-$EXTRACT(X2,1,3)-($EXTRACT(X1,4,7)<$EXTRACT(X2,4,7))
- +4 DO TECH^SROPRIN
- SET SRANES=$SELECT(SRTECH'="":SRTECH,1:"NOT ENTERED")
- +5 WRITE !,SRSDATE,?22,SRSNM,?54,$SELECT(SRSPEC:$EXTRACT(SRDOC,1,27),1:$EXTRACT(SRSS,1,27)),?89,SRANES,?117,SRIOSTAT
- +6 WRITE !,SRTN,?22,SRSSN_" ("_SRAGE_")",?54,SRPROC(1),!
- SET I=1
- FOR
- SET I=$ORDER(SRPROC(I))
- if 'I
- QUIT
- WRITE ?54,SRPROC(I),!
- +7 if $Y+9>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- SET SRL=78
- DO PROC^SROUTLN
- WRITE !,?54,SRPROC(1),!
- SET I=1
- FOR
- SET I=$ORDER(SRPROC(I))
- if 'I
- QUIT
- WRITE ?54,SRPROC(I),!
- +8 QUIT
- PRESS WRITE !!
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- +1 QUIT
- PAGE IF $EXTRACT(IOST)="P"!SRHDR
- GOTO HDR
- +1 DO PRESS
- IF SRSOUT
- QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 if $Y
- WRITE @IOF
- if $EXTRACT(IOST)="P"
- WRITE !,?(IOM-$LENGTH(SRINST)\2),SRINST
- WRITE !,?(IOM-$LENGTH(SRRPT)\2),SRRPT,?(IOM-10),$JUSTIFY("PAGE "_SRPAGE,9),!,?(IOM-$LENGTH(SRFRTO)\2),SRFRTO
- if $EXTRACT(IOST)="P"
- WRITE !,?(IOM-$LENGTH(SRPRINT)\2),SRPRINT
- +3 IF SRSPEC
- SET X="SURGICAL SPECIALTY: "_SRSPECN
- WRITE !,?(IOM-$LENGTH(X)\2),X
- +4 WRITE !!,"DATE OF OPERATION",?22,"PATIENT NAME",?54,$SELECT(SRSPEC:"SURGEON",1:"SURGICAL SPECIALTY"),?89,"ANESTHESIA TECHNIQUE",?117,"IN/OUT-PATIENT"
- +5 WRITE !,"CASE #",?22,"PATIENT ID (AGE)",?54,"PROCEDURE(S) PERFORMED"
- +6 SET SRHDR=0
- SET SRPAGE=SRPAGE+1
- WRITE !
- FOR I=1:1:IOM
- WRITE "="
- +7 QUIT
