SROPCEU.m

SROPCEU ;BIR/ADM-List/Refile Not Transmitted Outpatient Encounters ; [ 09/22/98  11:41 AM ]

 ;;3.0; Surgery ;**69,77,50**;24 Jun 93

 S (SRFLG,SRSORT,SRSOUT)=0,SRSPEC=""

 W @IOF,!,?13,"Outpatient Surgery Encounters Not Transmitted to NPCD",!!!,"Surgical cases filed with PCE that have no Scheduling appointment status",!,"or that have an appointment status of ACTION REQUIRED or NON-COUNT indicate"

 W !,"surgical encounters that have not transmitted to the National Patient",!,"Care Database.  This option is intended as a tool to identify these",!,"encounters and, after taking appropriate corrective measures, to"

 W !,"reinitiate the encounter transmission process.",!!

ASK K DIR S DIR("A",1)="  1. Print list of cases.",DIR("A",2)="  2. Print total number of cases only.",DIR("A",3)="  3. Re-file cases in PCE.",DIR("A",4)="",DIR("A")="Select Number: ",DIR("B")=1

 S DIR("?",1)="Enter 1 to print a list of surgical cases and/or non-OR procedures that are",DIR("?",2)="filed in PCE, but have no Scheduling appointment status or have an"

 S DIR("?",3)="an appointment status of ACTION REQUIRED or NON-COUNT.",DIR("?",4)="",DIR("?",5)="Enter 2 to print the total number of cases only with no list."

 S DIR("?",6)="",DIR("?",7)="Enter 3 to re-file in PCE surgical cases and/or non-OR procedures that are"

 S DIR("?",8)="already filed, but have no Scheduling appointment status or have an",DIR("?")="appointment status of ACTION REQUIRED or NON-COUNT."

 S DIR(0)="NA^1:3:0" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q

 S SRSEL=Y W !!

 S DIR("A",1)=$S(SRSEL=1:"Print the list for",SRSEL=2:"Print totals for",1:"Re-file")_" the following.",DIR("A",2)="",DIR("A",3)="  1. O.R. Surgical Procedures",DIR("A",4)="  2. Non-O.R. Procedures"

 S DIR("A",5)="  3. Both O.R. Surgical Procedures and Non-O.R. Procedures (All Specialties)",DIR("A",6)="",DIR("A")="Select Number (1, 2 or 3): ",DIR("B")="1"

 S DIR(0)="NA^1:3:0" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q

 S SRFLG=Y I SRFLG=1 D SPEC I SRSOUT D END Q

 I SRFLG=2 D MSP I SRSOUT D END Q

 I SRFLG=3 D ALL I SRSOUT D END Q

DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END

 I SRSEL'=3 W ! K %ZIS,IOP,IO("Q"),POP D  I SRSOUT D END Q

 .S %ZIS("A")="Print report on which printer ? ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1

 .I $D(IO("Q")) K IO("Q") D ZT D ^%ZTLOAD S SRSOUT=1

 I SRSEL=3 D ZT S ZTIO="" D ^%ZTLOAD W:$G(ZTSK) !," (Task #"_ZTSK_")" D END Q

EN D TMP I SRSEL'=3 D ^SROPCEU0

 I SRSEL=3 D REFILE^SROPCEU0

END W:$E(IOST)="P" @IOF K ^TMP("SR69",$J),^TMP("SRSP",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q

 I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue  " R X:DTIME

 D ^%ZISC K SR12,SRDIV,SRDX,SRENC,SRFCPT,SRFICD,SRFRTO,SRINOUT,SRPARAM,SRPODX,SRQCPT,SRQICD,SRRPT,SRSEL,SRSORT,SRSPS,SRSR,SRTN,SRUCPT,SRUICD D ^SRSKILL W @IOF

 Q

ZT S ZTDESC=$S(SRSEL=2:"Re-file",1:"Report of")_" Untransmitted Surgery Oupatient Encounters"

 S (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRSITE*"),ZTSAVE("SRSPEC*"),ZTSAVE("SRFLG"),ZTSAVE("SRSEL"),ZTSAVE("SRSORT"))=""

 S ZTRTN="EN^SROPCEU"

 Q

SPEC W ! S DIR("?",1)="Enter YES if you would like "_$S(SRSEL=3:"re-filing",1:"the report printed")_" for all Surgical Specialties",DIR("?")="or enter NO to select a specific specialty."

 S DIR("A")="Do you want "_$S(SRSEL=3:"re-filing",1:"the report")_" for all Surgical Specialties ? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q

 I Y D ALL Q

 I 'Y W ! K DIC S DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select Surgical Specialty: ",DIC("S")="I '$P(^(0),""^"",3)" D ^DIC K DIC S:Y<0 SRSOUT=1 Q:Y<0  S SRSPEC=+Y,SRSPECN=$P(Y(0),"^")

 Q

ALL Q:SRSEL=3  W ! I SRSEL=1 D

 .S DIR("?",1)="Enter YES if you would like the report to be sorted by specialty.  Enter NO",DIR("?")="if you would like all specialties combined and sorted by case number.",DIR("A")="Do you want the report sorted by Specialty ? "

 I SRSEL=2 D

 .S DIR("?",1)="Enter YES if you would like the report to give totals for each specialty.",DIR("?")="Enter NO if you would like totals for all specialties combined.",DIR("A")="Do you want totals separated by Specialty ? "

 S DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q

 I Y S SRSORT=1

 Q

MSP W ! S DIR("?",1)="Enter YES if you would like "_$S(SRSEL=3:"re-filing",1:"the report printed")_" for all Medical Specialties",DIR("?")="or enter NO to select a specific specialty."

 S DIR("A")="Do you want "_$S(SRSEL=3:"re-filing",1:"the report")_" for all Medical Specialties ? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q

 I Y D ALL Q

 I 'Y W ! K DIC S DIC=723,DIC(0)="QEAMZ",DIC("A")="Select Medical Specialty: " D ^DIC K DIC S:Y<0 SRSOUT=1 Q:Y<0  S SRSPEC=+Y,SRSPECN=$P(Y(0),"^")

 Q

TMP ; identify cases with not transmitted encounters

 N SRVSIT S SRSDT=SDATE-.0001,SRSEDT=EDATE+.9999 K ^TMP("SR69",$J),^TMP("SRSP",$J) S:SRSORT ^TMP("SRSP",$J,0)="0^0^0^0" S SRCNT=0 F I=0,12,14 S SRCNT(I)=0

 F  S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT!(SRSDT>SRSEDT)  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN  I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D

 .S SR=^SRF(SRTN,0),SR12=$P(SR,"^",12),SRVSIT=$P(SR,"^",15) Q:'SRVSIT!(SR12'="O")

 .S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1

 .I SRFLG=1,SRNON Q

 .I SRFLG=2,'SRNON Q

 .S SRSS=$S('SRNON:$P(SR,"^",4),1:$P(^SRF(SRTN,"NON"),"^",8)) I SRSPEC,SRSPEC'=SRSS Q

 .I 'SRNON S SRSS="1;;"_$P(^SRO(137.45,SRSS,0),"^")

 .I SRNON S SRSS="2;;"_$P(^ECC(723,SRSS,0),"^")

 .S SRENC=$O(^SCE("AVSIT",SRVSIT,0))

 .I 'SRENC D  S SRCNT(0)=SRCNT(0)+1 Q

 ..I '$D(^TMP("SRSP",$J,SRSS,0)) S ^TMP("SRSP",$J,SRSS,0)="0^0^0^0"

 ..S ^TMP("SRSP",$J,SRSS,SRTN)="",$P(^TMP("SRSP",$J,SRSS,0),"^")=$P(^TMP("SRSP",$J,SRSS,0),"^")+1,^TMP("SR69",$J,SRTN)=""

 .K SRX S DA=SRENC,DIC=409.68,DR=".12",DIQ="SRX",DIQ(0)="IE" D EN^DIQ1 K DA,DIC,DIQ,DR

 .S SRZ=SRX(409.68,SRENC,.12,"I") I SRZ'=12&(SRZ'=14) Q

 .S SRCNT(SRZ)=SRCNT(SRZ)+1,^TMP("SR69",$J,SRTN)=SRX(409.68,SRENC,.12,"E")

 .I '$D(^TMP("SRSP",$J,SRSS,0)) S ^TMP("SRSP",$J,SRSS,0)="0^0^0^0"

 .S ^TMP("SRSP",$J,SRSS,SRTN)=SRX(409.68,SRENC,.12,"E"),$P(^TMP("SRSP",$J,SRSS,0),"^",$S(SRZ=12:2,1:3))=$P(^TMP("SRSP",$J,SRSS,0),"^",$S(SRZ=12:2,1:3))+1

 F I=0,12,14 S SRCNT=SRCNT+SRCNT(I)

 S ^TMP("SRSP",$J,0)=SRCNT(0)_"^"_SRCNT(12)_"^"_SRCNT(14)_"^"_SRCNT

 S SRSS=0 F  S SRSS=$O(^TMP("SRSP",$J,SRSS)) Q:SRSS=""  D

 .S X=0 F I=1:1:3 S X=X+$P(^TMP("SRSP",$J,SRSS,0),"^",I)

 .S $P(^TMP("SRSP",$J,SRSS,0),"^",4)=X

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROPCEU   6500     printed  Mar 13, 2025@21:50:08                                                                                                                                                                                                     Page 2

SROPCEU   ;BIR/ADM-List/Refile Not Transmitted Outpatient Encounters ; [ 09/22/98  11:41 AM ]

 +1       ;;3.0; Surgery ;**69,77,50**;24 Jun 93

 +2        SET (SRFLG,SRSORT,SRSOUT)=0

           SET SRSPEC=""

 +3        WRITE @IOF,!,?13,"Outpatient Surgery Encounters Not Transmitted to NPCD",!!!,"Surgical cases filed with PCE that have no Scheduling appointment status",!,"or that have an appointment status of ACTION REQUIRED or NON-COUNT indicate"

 +4        WRITE !,"surgical encounters that have not transmitted to the National Patient",!,"Care Database.  This option is intended as a tool to identify these",!,"encounters and, after taking appropriate corrective measures, to"

 +5        WRITE !,"reinitiate the encounter transmission process.",!!

ASK        KILL DIR

           SET DIR("A",1)="  1. Print list of cases."

           SET DIR("A",2)="  2. Print total number of cases only."

           SET DIR("A",3)="  3. Re-file cases in PCE."

           SET DIR("A",4)=""

           SET DIR("A")="Select Number: "

           SET DIR("B")=1

 +1        SET DIR("?",1)="Enter 1 to print a list of surgical cases and/or non-OR procedures that are"

           SET DIR("?",2)="filed in PCE, but have no Scheduling appointment status or have an"

 +2        SET DIR("?",3)="an appointment status of ACTION REQUIRED or NON-COUNT."

           SET DIR("?",4)=""

           SET DIR("?",5)="Enter 2 to print the total number of cases only with no list."

 +3        SET DIR("?",6)=""

           SET DIR("?",7)="Enter 3 to re-file in PCE surgical cases and/or non-OR procedures that are"

 +4        SET DIR("?",8)="already filed, but have no Scheduling appointment status or have an"

           SET DIR("?")="appointment status of ACTION REQUIRED or NON-COUNT."

 +5        SET DIR(0)="NA^1:3:0"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               DO END

               QUIT 

 +6        SET SRSEL=Y

           WRITE !!

 +7        SET DIR("A",1)=$SELECT(SRSEL=1:"Print the list for",SRSEL=2:"Print totals for",1:"Re-file")_" the following."

           SET DIR("A",2)=""

           SET DIR("A",3)="  1. O.R. Surgical Procedures"

           SET DIR("A",4)="  2. Non-O.R. Procedures"

 +8        SET DIR("A",5)="  3. Both O.R. Surgical Procedures and Non-O.R. Procedures (All Specialties)"

           SET DIR("A",6)=""

           SET DIR("A")="Select Number (1, 2 or 3): "

           SET DIR("B")="1"

 +9        SET DIR(0)="NA^1:3:0"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               DO END

               QUIT 

 +10       SET SRFLG=Y

           IF SRFLG=1

               DO SPEC

               IF SRSOUT

                   DO END

                   QUIT 

 +11       IF SRFLG=2

               DO MSP

               IF SRSOUT

                   DO END

                   QUIT 

 +12       IF SRFLG=3

               DO ALL

               IF SRSOUT

                   DO END

                   QUIT 

DATE       DO DATE^SROUTL(.SDATE,.EDATE,.SRSOUT)

           if SRSOUT

               GOTO END

 +1        IF SRSEL'=3

               WRITE !

               KILL %ZIS,IOP,IO("Q"),POP

               Begin DoDot:1

 +2                SET %ZIS("A")="Print report on which printer ? "

                   SET %ZIS="Q"

                   DO ^%ZIS

                   IF POP

                       SET SRSOUT=1

 +3                IF $DATA(IO("Q"))

                       KILL IO("Q")

                       DO ZT

                       DO ^%ZTLOAD

                       SET SRSOUT=1

               End DoDot:1

               IF SRSOUT

                   DO END

                   QUIT 

 +4        IF SRSEL=3

               DO ZT

               SET ZTIO=""

               DO ^%ZTLOAD

               if $GET(ZTSK)

                   WRITE !," (Task #"_ZTSK_")"

               DO END

               QUIT 

EN         DO TMP

           IF SRSEL'=3

               DO ^SROPCEU0

 +1        IF SRSEL=3

               DO REFILE^SROPCEU0

END        if $EXTRACT(IOST)="P"

               WRITE @IOF

           KILL ^TMP("SR69",$JOB),^TMP("SRSP",$JOB)

           IF $DATA(ZTQUEUED)

               if $GET(ZTSTOP)

                   QUIT 

               SET ZTREQ="@"

               QUIT 

 +1        IF 'SRSOUT

               IF $EXTRACT(IOST)'="P"

                   WRITE !!,"Press RETURN to continue  "

                   READ X:DTIME

 +2        DO ^%ZISC

           KILL SR12,SRDIV,SRDX,SRENC,SRFCPT,SRFICD,SRFRTO,SRINOUT,SRPARAM,SRPODX,SRQCPT,SRQICD,SRRPT,SRSEL,SRSORT,SRSPS,SRSR,SRTN,SRUCPT,SRUICD

           DO ^SRSKILL

           WRITE @IOF

 +3        QUIT 

ZT         SET ZTDESC=$SELECT(SRSEL=2:"Re-file",1:"Report of")_" Untransmitted Surgery Oupatient Encounters"

 +1        SET (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRSITE*"),ZTSAVE("SRSPEC*"),ZTSAVE("SRFLG"),ZTSAVE("SRSEL"),ZTSAVE("SRSORT"))=""

 +2        SET ZTRTN="EN^SROPCEU"

 +3        QUIT 

SPEC       WRITE !

           SET DIR("?",1)="Enter YES if you would like "_$SELECT(SRSEL=3:"re-filing",1:"the report printed")_" for all Surgical Specialties"

           SET DIR("?")="or enter NO to select a specific specialty."

 +1        SET DIR("A")="Do you want "_$SELECT(SRSEL=3:"re-filing",1:"the report")_" for all Surgical Specialties ? "

           SET DIR("B")="YES"

           SET DIR(0)="YA"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               QUIT 

 +2        IF Y

               DO ALL

               QUIT 

 +3        IF 'Y

               WRITE !

               KILL DIC

               SET DIC=137.45

               SET DIC(0)="QEAMZ"

               SET DIC("A")="Select Surgical Specialty: "

               SET DIC("S")="I '$P(^(0),""^"",3)"

               DO ^DIC

               KILL DIC

               if Y<0

                   SET SRSOUT=1

               if Y<0

                   QUIT 

               SET SRSPEC=+Y

               SET SRSPECN=$PIECE(Y(0),"^")

 +4        QUIT 

ALL        if SRSEL=3

               QUIT 

           WRITE !

           IF SRSEL=1

               Begin DoDot:1

 +1                SET DIR("?",1)="Enter YES if you would like the report to be sorted by specialty.  Enter NO"

                   SET DIR("?")="if you would like all specialties combined and sorted by case number."

                   SET DIR("A")="Do you want the report sorted by Specialty ? "

               End DoDot:1

 +2        IF SRSEL=2

               Begin DoDot:1

 +3                SET DIR("?",1)="Enter YES if you would like the report to give totals for each specialty."

                   SET DIR("?")="Enter NO if you would like totals for all specialties combined."

                   SET DIR("A")="Do you want totals separated by Specialty ? "

               End DoDot:1

 +4        SET DIR("B")="YES"

           SET DIR(0)="YA"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               QUIT 

 +5        IF Y

               SET SRSORT=1

 +6        QUIT 

MSP        WRITE !

           SET DIR("?",1)="Enter YES if you would like "_$SELECT(SRSEL=3:"re-filing",1:"the report printed")_" for all Medical Specialties"

           SET DIR("?")="or enter NO to select a specific specialty."

 +1        SET DIR("A")="Do you want "_$SELECT(SRSEL=3:"re-filing",1:"the report")_" for all Medical Specialties ? "

           SET DIR("B")="YES"

           SET DIR(0)="YA"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               QUIT 

 +2        IF Y

               DO ALL

               QUIT 

 +3        IF 'Y

               WRITE !

               KILL DIC

               SET DIC=723

               SET DIC(0)="QEAMZ"

               SET DIC("A")="Select Medical Specialty: "

               DO ^DIC

               KILL DIC

               if Y<0

                   SET SRSOUT=1

               if Y<0

                   QUIT 

               SET SRSPEC=+Y

               SET SRSPECN=$PIECE(Y(0),"^")

 +4        QUIT 

TMP       ; identify cases with not transmitted encounters

 +1        NEW SRVSIT

           SET SRSDT=SDATE-.0001

           SET SRSEDT=EDATE+.9999

           KILL ^TMP("SR69",$JOB),^TMP("SRSP",$JOB)

           if SRSORT

               SET ^TMP("SRSP",$JOB,0)="0^0^0^0"

           SET SRCNT=0

           FOR I=0,12,14

               SET SRCNT(I)=0

 +2        FOR 

               SET SRSDT=$ORDER(^SRF("AC",SRSDT))

               if 'SRSDT!(SRSDT>SRSEDT)

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))

                   if 'SRTN

                       QUIT 

                   IF $DATA(^SRF(SRTN,0))

                       IF $$DIV^SROUTL0(SRTN)

                           Begin DoDot:1

 +3                            SET SR=^SRF(SRTN,0)

                               SET SR12=$PIECE(SR,"^",12)

                               SET SRVSIT=$PIECE(SR,"^",15)

                               if 'SRVSIT!(SR12'="O")

                                   QUIT 

 +4                            SET SRNON=0

                               IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"

                                   SET SRNON=1

 +5                            IF SRFLG=1

                                   IF SRNON

                                       QUIT 

 +6                            IF SRFLG=2

                                   IF 'SRNON

                                       QUIT 

 +7                            SET SRSS=$SELECT('SRNON:$PIECE(SR,"^",4),1:$PIECE(^SRF(SRTN,"NON"),"^",8))

                               IF SRSPEC

                                   IF SRSPEC'=SRSS

                                       QUIT 

 +8                            IF 'SRNON

                                   SET SRSS="1;;"_$PIECE(^SRO(137.45,SRSS,0),"^")

 +9                            IF SRNON

                                   SET SRSS="2;;"_$PIECE(^ECC(723,SRSS,0),"^")

 +10                           SET SRENC=$ORDER(^SCE("AVSIT",SRVSIT,0))

 +11                           IF 'SRENC

                                   Begin DoDot:2

 +12                                   IF '$DATA(^TMP("SRSP",$JOB,SRSS,0))

                                           SET ^TMP("SRSP",$JOB,SRSS,0)="0^0^0^0"

 +13                                   SET ^TMP("SRSP",$JOB,SRSS,SRTN)=""

                                       SET $PIECE(^TMP("SRSP",$JOB,SRSS,0),"^")=$PIECE(^TMP("SRSP",$JOB,SRSS,0),"^")+1

                                       SET ^TMP("SR69",$JOB,SRTN)=""

                                   End DoDot:2

                                   SET SRCNT(0)=SRCNT(0)+1

                                   QUIT 

 +14                           KILL SRX

                               SET DA=SRENC

                               SET DIC=409.68

                               SET DR=".12"

                               SET DIQ="SRX"

                               SET DIQ(0)="IE"

                               DO EN^DIQ1

                               KILL DA,DIC,DIQ,DR

 +15                           SET SRZ=SRX(409.68,SRENC,.12,"I")

                               IF SRZ'=12&(SRZ'=14)

                                   QUIT 

 +16                           SET SRCNT(SRZ)=SRCNT(SRZ)+1

                               SET ^TMP("SR69",$JOB,SRTN)=SRX(409.68,SRENC,.12,"E")

 +17                           IF '$DATA(^TMP("SRSP",$JOB,SRSS,0))

                                   SET ^TMP("SRSP",$JOB,SRSS,0)="0^0^0^0"

 +18                           SET ^TMP("SRSP",$JOB,SRSS,SRTN)=SRX(409.68,SRENC,.12,"E")

                               SET $PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",$SELECT(SRZ=12:2,1:3))=$PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",$SELECT(SRZ=12:2,1:3))+1

                           End DoDot:1

 +19       FOR I=0,12,14

               SET SRCNT=SRCNT+SRCNT(I)

 +20       SET ^TMP("SRSP",$JOB,0)=SRCNT(0)_"^"_SRCNT(12)_"^"_SRCNT(14)_"^"_SRCNT

 +21       SET SRSS=0

           FOR 

               SET SRSS=$ORDER(^TMP("SRSP",$JOB,SRSS))

               if SRSS=""

                   QUIT 

               Begin DoDot:1

 +22               SET X=0

                   FOR I=1:1:3

                       SET X=X+$PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",I)

 +23               SET $PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",4)=X

               End DoDot:1

 +24       QUIT