- SROPCEU0 ;BIR/ADM - UNTRANSMITTED OUTPATIENT ENCOUNTERS (CONT.) ;06/21/05
- ;;3.0; Surgery ;**69,77,50,142**;24 Jun 93
- ;
- ; Reference to ^ECC(723 supported by DBIA #205
- ;
- U IO S (SRNEW,SRSOUT,SRSUB)=0,(SRHDR,SRPAGE)=1,Y=SDATE X ^DD("DD") S STARTDT=Y,Y=EDATE X ^DD("DD") S ENDATE=Y
- S SRRPT="Outpatient Surgery Encounters Not Transmitted to NPCD"
- S SRTITLE="For Completed "_$S(SRFLG=1:"O.R. Surgical Procedures",SRFLG=2:"Non-O.R. Procedures",1:"O.R. Surgical and Non-O.R. Procedures")
- S SRFRTO="From: "_STARTDT_" To: "_ENDATE,SRINST=SRSITE("SITE") D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S SRPRINT="Report Printed: "_Y
- I SRSORT G S1
- D HDR I SRSEL=1 S SRTN=0 F S SRTN=$O(^TMP("SR69",$J,SRTN)) Q:'SRTN!SRSOUT D CASE
- Q:SRSOUT D:$Y+10>IOSL PAGE Q:SRSOUT
- W !!,$S(SRSPEC:"SPECIALTY: "_SRSPECN,1:" * * * ALL SPECIALTIES * * *")
- TOT W !!," Total with NO status: ",$J(SRCNT(0),5)
- W !," Total with NON-COUNT: ",$J(SRCNT(12),5)
- W !,"Total with ACTION REQUIRED: ",$J(SRCNT(14),5),!,?28,"-----"
- W !," Total cases identified: ",$J(SRCNT,5) S SRSUB=0
- Q
- S1 S (SRSP,SRSPECN)=0 F S SRSPECN=$O(^TMP("SRSP",$J,SRSPECN)) Q:SRSPECN=""!SRSOUT S SRNEW=1 D PAGE Q:SRSOUT D
- .I SRSEL=1 S SRTN=0 F S SRTN=$O(^TMP("SRSP",$J,SRSPECN,SRTN)) Q:'SRTN!SRSOUT D CASE
- .Q:SRSOUT S X=^TMP("SRSP",$J,SRSPECN,0),SRCNT(0)=$P(X,"^"),SRCNT(12)=$P(X,"^",2),SRCNT(14)=$P(X,"^",3),SRCNT=$P(X,"^",4),SRSUB=1 D:$Y+10>IOSL PAGE Q:SRSOUT
- .D TOT
- Q:SRSOUT S SRSUB=1 D PAGE Q:SRSOUT W !!," * * * COMBINED TOTALS FOR ALL SPECIALTIES * * *" S X=^TMP("SRSP",$J,0),SRCNT(0)=$P(X,"^"),SRCNT(12)=$P(X,"^",2),SRCNT(14)=$P(X,"^",3),SRCNT=$P(X,"^",4) D TOT
- Q
- SUBHD W !!,">>> "_$S($P(SRSPECN,";;")=1:"SURGICAL",1:"MEDICAL")_" SPECIALTY: "_$P(SRSPECN,";;",2)_$S('SRNEW:" * * continued * *",1:"")
- S SRNEW=0 I SRSORT W !
- Q
- CASE ; print case info
- D:$Y+6>IOSL PAGE Q:SRSOUT
- S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
- S SRSS=$S('SRNON:$P(^SRF(SRTN,0),"^",4),1:$P(^SRF(SRTN,"NON"),"^",8)),SRSSNM=$S('SRNON:$P(^SRO(137.45,SRSS,0),"^"),1:$P(^ECC(723,SRSS,0),"^"))
- S SRSTATUS=$S('SRSORT:^TMP("SR69",$J,SRTN),1:^TMP("SRSP",$J,SRSPECN,SRTN)) I SRSTATUS="" S SRSTATUS="<NONE>"
- I SRSORT D CLIN
- D DEM,PROC W !,SRSDATE,?23,SRTN,?38,$S(SRSORT:$E(SRLOC,1,20),1:$E(SRSSNM,1,20)),?61,$S(IOM<82:$E(SRSTATUS,1,19),1:SRSTATUS)
- W !,SRSNM,?23,SRPROC(1),!,SRSSN_" ("_SRAGE_")" W:$D(SRPROC(2)) ?23,SRPROC(2) W:(SRFLG=3)&SRNON !,"NON-O.R." I $D(SRPROC(3)) W:'SRNON ! W ?23,SRPROC(3)
- W ! F I=1:1:IOM W "-"
- Q
- DEM ; get patient dempgraphic information
- S SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT S SRSNM=VADM(1),SRSSN=VA("PID"),(SRSDT,Y)=$P(SR(0),"^",9) X ^DD("DD") S SRSDATE=Y,X1=$E(SRSDT,1,7),X2=$P(VADM(3),"^"),SRAGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7))
- I $L(SRSNM)>21 S SRSNM=$P(VADM(1),",")_","_$E($P(VADM(1),"^",2))_"."
- Q
- PROC ; get principal procedure
- K SRPROC S X=$P(^SRF(SRTN,"OP"),"^") I $L(X)<58 S SRPROC(1)=X
- I $L(X)>57 S K=1 F D I $L(X)<58 S SRPROC(K)=X Q
- .F I=0:1:56 S J=57-I,Y=$E(X,J) I Y=" " S SRPROC(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
- Q
- CLIN ; get associated clinic
- S X=$P(^SRF(SRTN,0),"^",21) I X S SRLOC=X
- I 'SRNON,'X S X=$P(^SRO(137.45,SRSS,0),"^",5) S:X SRLOC=X I 'X S Y=$P(^SRF(SRTN,0),"^",2) I Y S X=$P(^SRS(Y,0),"^") I X S SRLOC=X
- I SRNON,'X S X=$P(^SRF(SRTN,"NON"),"^",2) I X S SRLOC=X
- S SRLOC=$S(SRLOC:$P(^SC(SRLOC,0),"^"),1:"<NOT ENTERED>")
- Q
- PAGE I $E(IOST)="P"!SRHDR D HDR Q
- W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 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(SRTITLE)\2),SRTITLE,!,?(IOM-$L(SRFRTO)\2),SRFRTO
- I $E(IOST)="P" W !,?(IOM-$L(SRPRINT)\2),SRPRINT W:SRSUB !
- I SRSEL=1,'SRSUB W !!,"DATE OF "_$S(SRFLG=1:"OPERATION",SRFLG=2:"PROCEDURE",1:"OP/PROCEDURE"),?23,"CASE #",?38,$S(SRSORT:"CLINIC",1:"SPECIALTY"),?61,"SCHED STATUS",!,"PATIENT NAME",?23,"PRINCIPAL PROCEDURE",!,"PATIENT ID (AGE)"
- S (SRHDR,SRSUB)=0,SRPAGE=SRPAGE+1 W ! F I=1:1:IOM W "="
- I SRSORT D:SRSPECN'="" SUBHD S SRNEW=0
- Q
- REFILE ; re-file cases in PCE
- N SRVISIT,SRVSIT K DIC S DIC=9.4,DIC(0)="XM",X="SURGERY" D ^DIC K DIC Q:Y=-1 S SRPKG=+Y
- S (SRK,SRTN)=0,SRS="SURGERY DATA",SRFILE=1
- F S SRTN=$O(^TMP("SR69",$J,SRTN)) Q:'SRTN D
- .S (SRVISIT,SRVSIT)=$P(^SRF(SRTN,0),"^",15),SRV=$$DELVFILE^PXAPI("PRV^POV^CPT",SRVSIT)
- .D UTIL^SROPCEP I 'SRK D
- ..D TMP^SROPCEP
- ..S SRVSIT=SRVISIT,SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,SRVSIT)
- ..K ^TMP("SRPXAPI",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPCEU0 4645 printed Feb 19, 2025@00:11:27 Page 2
- SROPCEU0 ;BIR/ADM - UNTRANSMITTED OUTPATIENT ENCOUNTERS (CONT.) ;06/21/05
- +1 ;;3.0; Surgery ;**69,77,50,142**;24 Jun 93
- +2 ;
- +3 ; Reference to ^ECC(723 supported by DBIA #205
- +4 ;
- +5 USE IO
- SET (SRNEW,SRSOUT,SRSUB)=0
- SET (SRHDR,SRPAGE)=1
- SET Y=SDATE
- XECUTE ^DD("DD")
- SET STARTDT=Y
- SET Y=EDATE
- XECUTE ^DD("DD")
- SET ENDATE=Y
- +6 SET SRRPT="Outpatient Surgery Encounters Not Transmitted to NPCD"
- +7 SET SRTITLE="For Completed "_$SELECT(SRFLG=1:"O.R. Surgical Procedures",SRFLG=2:"Non-O.R. Procedures",1:"O.R. Surgical and Non-O.R. Procedures")
- +8 SET SRFRTO="From: "_STARTDT_" To: "_ENDATE
- SET SRINST=SRSITE("SITE")
- DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- SET SRPRINT="Report Printed: "_Y
- +9 IF SRSORT
- GOTO S1
- +10 DO HDR
- IF SRSEL=1
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SR69",$JOB,SRTN))
- if 'SRTN!SRSOUT
- QUIT
- DO CASE
- +11 if SRSOUT
- QUIT
- if $Y+10>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- +12 WRITE !!,$SELECT(SRSPEC:"SPECIALTY: "_SRSPECN,1:" * * * ALL SPECIALTIES * * *")
- TOT WRITE !!," Total with NO status: ",$JUSTIFY(SRCNT(0),5)
- +1 WRITE !," Total with NON-COUNT: ",$JUSTIFY(SRCNT(12),5)
- +2 WRITE !,"Total with ACTION REQUIRED: ",$JUSTIFY(SRCNT(14),5),!,?28,"-----"
- +3 WRITE !," Total cases identified: ",$JUSTIFY(SRCNT,5)
- SET SRSUB=0
- +4 QUIT
- S1 SET (SRSP,SRSPECN)=0
- FOR
- SET SRSPECN=$ORDER(^TMP("SRSP",$JOB,SRSPECN))
- if SRSPECN=""!SRSOUT
- QUIT
- SET SRNEW=1
- DO PAGE
- if SRSOUT
- QUIT
- Begin DoDot:1
- +1 IF SRSEL=1
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SRSP",$JOB,SRSPECN,SRTN))
- if 'SRTN!SRSOUT
- QUIT
- DO CASE
- +2 if SRSOUT
- QUIT
- SET X=^TMP("SRSP",$JOB,SRSPECN,0)
- SET SRCNT(0)=$PIECE(X,"^")
- SET SRCNT(12)=$PIECE(X,"^",2)
- SET SRCNT(14)=$PIECE(X,"^",3)
- SET SRCNT=$PIECE(X,"^",4)
- SET SRSUB=1
- if $Y+10>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- +3 DO TOT
- End DoDot:1
- +4 if SRSOUT
- QUIT
- SET SRSUB=1
- DO PAGE
- if SRSOUT
- QUIT
- WRITE !!," * * * COMBINED TOTALS FOR ALL SPECIALTIES * * *"
- SET X=^TMP("SRSP",$JOB,0)
- SET SRCNT(0)=$PIECE(X,"^")
- SET SRCNT(12)=$PIECE(X,"^",2)
- SET SRCNT(14)=$PIECE(X,"^",3)
- SET SRCNT=$PIECE(X,"^",4)
- DO TOT
- +5 QUIT
- SUBHD WRITE !!,">>> "_$SELECT($PIECE(SRSPECN,";;")=1:"SURGICAL",1:"MEDICAL")_" SPECIALTY: "_$PIECE(SRSPECN,";;",2)_$SELECT('SRNEW:" * * continued * *",1:"")
- +1 SET SRNEW=0
- IF SRSORT
- WRITE !
- +2 QUIT
- CASE ; print case info
- +1 if $Y+6>IOSL
- DO PAGE
- if SRSOUT
- QUIT
- +2 SET SRNON=0
- IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
- SET SRNON=1
- +3 SET SRSS=$SELECT('SRNON:$PIECE(^SRF(SRTN,0),"^",4),1:$PIECE(^SRF(SRTN,"NON"),"^",8))
- SET SRSSNM=$SELECT('SRNON:$PIECE(^SRO(137.45,SRSS,0),"^"),1:$PIECE(^ECC(723,SRSS,0),"^"))
- +4 SET SRSTATUS=$SELECT('SRSORT:^TMP("SR69",$JOB,SRTN),1:^TMP("SRSP",$JOB,SRSPECN,SRTN))
- IF SRSTATUS=""
- SET SRSTATUS="<NONE>"
- +5 IF SRSORT
- DO CLIN
- +6 DO DEM
- DO PROC
- WRITE !,SRSDATE,?23,SRTN,?38,$SELECT(SRSORT:$EXTRACT(SRLOC,1,20),1:$EXTRACT(SRSSNM,1,20)),?61,$SELECT(IOM<82:$EXTRACT(SRSTATUS,1,19),1:SRSTATUS)
- +7 WRITE !,SRSNM,?23,SRPROC(1),!,SRSSN_" ("_SRAGE_")"
- if $DATA(SRPROC(2))
- WRITE ?23,SRPROC(2)
- if (SRFLG=3)&SRNON
- WRITE !,"NON-O.R."
- IF $DATA(SRPROC(3))
- if 'SRNON
- WRITE !
- WRITE ?23,SRPROC(3)
- +8 WRITE !
- FOR I=1:1:IOM
- WRITE "-"
- +9 QUIT
- DEM ; get patient dempgraphic information
- +1 SET SR(0)=^SRF(SRTN,0)
- SET DFN=$PIECE(SR(0),"^")
- DO DEM^VADPT
- SET SRSNM=VADM(1)
- SET SRSSN=VA("PID")
- SET (SRSDT,Y)=$PIECE(SR(0),"^",9)
- XECUTE ^DD("DD")
- SET SRSDATE=Y
- SET X1=$EXTRACT(SRSDT,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))
- +2 IF $LENGTH(SRSNM)>21
- SET SRSNM=$PIECE(VADM(1),",")_","_$EXTRACT($PIECE(VADM(1),"^",2))_"."
- +3 QUIT
- PROC ; get principal procedure
- +1 KILL SRPROC
- SET X=$PIECE(^SRF(SRTN,"OP"),"^")
- IF $LENGTH(X)<58
- SET SRPROC(1)=X
- +2 IF $LENGTH(X)>57
- SET K=1
- FOR
- Begin DoDot:1
- +3 FOR I=0:1:56
- SET J=57-I
- SET Y=$EXTRACT(X,J)
- IF Y=" "
- SET SRPROC(K)=$EXTRACT(X,1,J-1)
- SET X=$EXTRACT(X,J+1,$LENGTH(X))
- SET K=K+1
- QUIT
- End DoDot:1
- IF $LENGTH(X)<58
- SET SRPROC(K)=X
- QUIT
- +4 QUIT
- CLIN ; get associated clinic
- +1 SET X=$PIECE(^SRF(SRTN,0),"^",21)
- IF X
- SET SRLOC=X
- +2 IF 'SRNON
- IF 'X
- SET X=$PIECE(^SRO(137.45,SRSS,0),"^",5)
- if X
- SET SRLOC=X
- IF 'X
- SET Y=$PIECE(^SRF(SRTN,0),"^",2)
- IF Y
- SET X=$PIECE(^SRS(Y,0),"^")
- IF X
- SET SRLOC=X
- +3 IF SRNON
- IF 'X
- SET X=$PIECE(^SRF(SRTN,"NON"),"^",2)
- IF X
- SET SRLOC=X
- +4 SET SRLOC=$SELECT(SRLOC:$PIECE(^SC(SRLOC,0),"^"),1:"<NOT ENTERED>")
- +5 QUIT
- PAGE IF $EXTRACT(IOST)="P"!SRHDR
- DO HDR
- QUIT
- +1 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET SRSOUT=1
- 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(SRTITLE)\2),SRTITLE,!,?(IOM-$LENGTH(SRFRTO)\2),SRFRTO
- +3 IF $EXTRACT(IOST)="P"
- WRITE !,?(IOM-$LENGTH(SRPRINT)\2),SRPRINT
- if SRSUB
- WRITE !
- +4 IF SRSEL=1
- IF 'SRSUB
- WRITE !!,"DATE OF "_$SELECT(SRFLG=1:"OPERATION",SRFLG=2:"PROCEDURE",1:"OP/PROCEDURE"),?23,"CASE #",?38,$SELECT(SRSORT:"CLINIC",1:"SPECIALTY"),?61,"SCHED STATUS",!,"PATIENT NAME",?23,"PRINCIPAL PROCEDURE",!,"PATIENT ID (AGE)"
- +5 SET (SRHDR,SRSUB)=0
- SET SRPAGE=SRPAGE+1
- WRITE !
- FOR I=1:1:IOM
- WRITE "="
- +6 IF SRSORT
- if SRSPECN'=""
- DO SUBHD
- SET SRNEW=0
- +7 QUIT
- REFILE ; re-file cases in PCE
- +1 NEW SRVISIT,SRVSIT
- KILL DIC
- SET DIC=9.4
- SET DIC(0)="XM"
- SET X="SURGERY"
- DO ^DIC
- KILL DIC
- if Y=-1
- QUIT
- SET SRPKG=+Y
- +2 SET (SRK,SRTN)=0
- SET SRS="SURGERY DATA"
- SET SRFILE=1
- +3 FOR
- SET SRTN=$ORDER(^TMP("SR69",$JOB,SRTN))
- if 'SRTN
- QUIT
- Begin DoDot:1
- +4 SET (SRVISIT,SRVSIT)=$PIECE(^SRF(SRTN,0),"^",15)
- SET SRV=$$DELVFILE^PXAPI("PRV^POV^CPT",SRVSIT)
- +5 DO UTIL^SROPCEP
- IF 'SRK
- Begin DoDot:2
- +6 DO TMP^SROPCEP
- +7 SET SRVSIT=SRVISIT
- SET SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,SRVSIT)
- +8 KILL ^TMP("SRPXAPI",$JOB)
- End DoDot:2
- End DoDot:1
- +9 QUIT