SCDXSUP ;RENO/KEITH ALB/SCK - Consistency checker for Ambulatory Care Reporting Project (ACRP); 02/26/97
;;5.3;Scheduling;**99**;Aug 13, 1993
;
CQ ;Queue re-calculation of OUTPATIENT ENCOUNTER checkout status
;
; Variable List
; SCBDT - Beginning date for search in Outpatient Encounter file
; SCDT - Outpatient Encounter date
; SCE0 - Zero node of the outpatient encounter
; OEIN - IEN of the outpatient encounter
; SCLINE - Dashed line for report
; SCPNOW - External date
; SCEDT - Ending date for search in Outpatient Encounter file
; PAGE - Number of pages
; SCCT - Count of entries processed
;
W !!,"This option will check outpatient encouters with a status of 'CHECKED OUT'"
W !,"for a entry in the TRANSMITTED OUTPATIENT ENCOUNTER file."
W !,"If no entry exists, and the encounter is for a COUNT Clinic, then "
W !,"a transmission entry will be added."
W !!,"This may take a while, please queue to a printer!",!
;
N SCBDT,SCEDT,SCPFLG
S SCBDT=$$ASKDT("Beginning")
Q:SCBDT<0
CQ1 S SCEDT=$$ASKDT("Ending")
Q:SCEDT<0
I SCEDT<SCBDT D G CQ1
. W !!,"Ending date cannot be earlier than the Beginning date!",!
;
S SCPFLG=1
N ZTSAVE,%ZIS
S %ZIS=0,ZTSAVE("SCBDT")="",ZTSAVE("SCEDT")="",ZTSAVE("SCPFLG")=""
D EN^XUTMDEVQ("CALC^SCDXSUP","Update Checkout Status",.ZTSAVE,.%ZIS)
Q
;
CQAPI(SCBG,SCED,SCPFLG) ; API entry point for re-calculation of OUTPATIENT ENCOUNTER checkout status
; INPUT:
; SCBG - Beginning date, if passed in, use it
; SCED - Ending date, if passed in, use it
; SCPFLG - Print Report flag
; 1 - Print report
; 0 - Do not print report
;
S SCBDT=$G(SCBG)
S SCEDT=$G(SCED)
;
CALC ;Update Checkout Status
;
N SCDT,OEIN,SCPNOW,SCLINE,SCE0,SCCT,SCABRT
;
K ^TMP("SCMSC",$J)
;
; ** Order through the Outpatatient Encounter file, if the encounter is the parent, evaluate it.
S SCDT=SCBDT-.1
F S SCDT=$O(^SCE("B",SCDT)) Q:'SCDT!(SCDT>(SCEDT+.99999)) D
. S OEIN=0 F S OEIN=$O(^SCE("B",SCDT,OEIN)) Q:'OEIN D
.. S SCE0=$G(^SCE(OEIN,0))
.. ; ** The following code removes any extraneous 'B' xrefs found that do not
.. ; point to a valid entry
.. I SCE0']"" D Q
... K ^SCE("B",SCDT,OEIN)
.. I '$P(SCE0,U,6) D EVAL(SCE0,OEIN,SCDT)
;
G:'$G(SCPFLG) EXIT
;
; ** Prepare report output
S SCLINE="",$P(SCLINE,"-",(IOM+1))=""
S SCPNOW=$P($$FMTE^XLFDT($$NOW^XLFDT()),":",1,2)
S SCBDT=$$FMTE^XLFDT(SCBDT)
S SCEDT=$$FMTE^XLFDT(SCEDT)
S PAGE=1,SCCT=0
;
CRTX ;
S SCHD="MISSING TRANSMISSION RECORDS CREATED"
D HDR
I '$D(^TMP("SCMSC",$J,2)) D G NEXT1
. W !!,"No encounters with missing transmission records found."
;
S (SCDT,SCCT)=0
F S SCDT=$O(^TMP("SCMSC",$J,2,SCDT)) Q:'SCDT D Q:$G(SCABRT)
. S OEIN=0 F S OEIN=$O(^TMP("SCMSC",$J,2,SCDT,OEIN)) Q:'OEIN D Q:$G(SCABRT)
.. S SCE0=^TMP("SCMSC",$J,2,SCDT,OEIN) D PRT(SCE0)
;
I $Y>(IOSL-5) D:$$NEWPAGE HDR
W !!,SCCT," transmission record",$S(SCCT=1:"",1:"s")," created."
;
NEXT1 ;
S SCHD="COUNT CLINIC ENCOUNTERS SET FOR RETRANSMIT"
S X=$$NEWPAGE Q:$G(SCABRT)
S PAGE=1
W:'(IOST?1"C-".E) @IOF
D HDR
I '$D(^TMP("SCMSC",$J,3)) D G EXIT
. W !!,"No Count Clinic encounters found needing retransmission."
;
S (SCDT,SCCT)=0
F S SCDT=$O(^TMP("SCMSC",$J,3,SCDT)) Q:'SCDT D Q:$G(SCABRT)
. S OEIN=0 F S OEIN=$O(^TMP("SCMSC",$J,3,SCDT,OEIN)) Q:'OEIN D Q:$G(SCABRT)
.. S SCE0=^TMP("SCMSC",$J,3,SCDT,OEIN) D PRT(SCE0)
;
D:$Y>(IOSL-5) HDR W !!,SCCT," Count clinic encounters marked for retransmission."
;
EXIT ;
K %ZIS,SCHD,PAGE,SCEDT,SCBDT,SCPT0
K ^TMP("SCMSC",$J)
Q
;
EVAL(SC0,OEIN,SDT) ;Evaluate checkout status
; ** If the encounter appt. status is CHECKED OUT, and the check out process is
; completed, but there is no entry for the encounter in the Transmitted
; Outpatient Encounter file, then process the encounter into the Transmitted
; Outpatient Encounter File, #409.73
;
; If clinic is NON-COUNT and Checked out, then change STATUS field, #.12, from
; CHECKED OUT to NON-COUNT and exit.
;
; Input:
; SC0 - 0 node of the Outpatient encounter
; OEIN - IEN of the Outpatient encounter
; SDT - Date of the Outpatient encounter
;
; Output
; ^TMP("SCMSC",$J,n,SDT,OEIN)=SC0
;
; Variables
; SCTOE - IEN of entry created in the Transmitted Outpatient Encounter file
; -1 if unable to create entry
;
N SCTOE
I $P(SC0,U,12)=2,$P(SC0,U,7),'$D(^SD(409.73,"AENC",OEIN)) D Q
. I $P($G(^SC(+$P(SC0,U,4),0)),U,17)="Y" D Q
.. S DA=OEIN,DR=".12////12",DIE="^SCE("
.. D ^DIE K DIE,DR
. S SCTOE=$$CRTXMIT^SCDXFU01(OEIN)
. I SCTOE>0 D STREEVNT^SCDXFU01(SCTOE,1),XMITFLAG^SCDXFU01(SCTOE,0) S ^TMP("SCMSC",$J,2,SDT,OEIN)=SC0
;
I $P(SC0,U,12)=12,$P(SC0,U,7) D
. I $P($G(^SC(+$P(SC0,U,4),0)),U,17)="Y" Q
. S DA=OEIN,DR=".12////2",DIE="^SCE("
. D ^DIE K DIE,DR
. S SCTOE=+$O(^SD(409.73,"AENC",OEIN,0))
. I 'SCTOE D
.. S SCTOE=$$CRTXMIT^SCDXFU01(OEIN)
. I SCTOE>0 D STREEVNT^SCDXFU01(SCTOE,1),XMITFLAG^SCDXFU01(SCTOE,0) S ^TMP("SCMSC",$J,3,SDT,OEIN)=SC0
;
Q
;
HDR ; Header
W:PAGE>1 @IOF
W !,SCLINE,!,?(IOM-($L(SCHD)+10)\2),"<*> ",SCHD," <*>",!,SCLINE
W !,"For date range ",SCBDT," to ",SCEDT
W !,"Date printed: ",SCPNOW,?(IOM-7-$L(PAGE)),"Page: ",PAGE,!
;
W !,"Patient",?21,"SSN",?33,"Appointment",?56,"Clinic",!,SCLINE
S PAGE=PAGE+1
;
Q
;
PRT(SC0) ;Print appointment
;
I $Y>(IOSL-5) D:$$NEWPAGE HDR Q:$G(SCABRT)
S SCCT=SCCT+1,SCPT0=^DPT($P(SC0,U,2),0)
W !,$E($P(SCPT0,U),1,18),?21,$P(SCPT0,U,9)
W ?33,$P($$FMTE^XLFDT($P(SC0,U)),":",1,2)
W ?56,$E($P($G(^SC(+$P(SC0,U,4),0)),U),1,(IOM-56))
Q
;
ASKDT(TXT) ; Enter beginning date for searching outpatient encounter file
S DIR(0)="DA^::EXP",DIR("A")="Enter "_TXT_" date for search: "
S DIR("?")="^D HELP^%DTC"
S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT())
D ^DIR K DIR
S:$D(DIRUT) Y=-1
K DIRUT
Q Y
;
NEWPAGE() ; Check device and display prompt for terminals
N DIR,SCOK
I IOST?1"C-".E D
. W !
. S DIR(0)="E" D ^DIR S SCABRT='$G(Y)
. I 'SCABRT S SCOK=1 W @IOF
Q +$G(SCOK)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXSUP 6272 printed Nov 22, 2024@17:49:31 Page 2
SCDXSUP ;RENO/KEITH ALB/SCK - Consistency checker for Ambulatory Care Reporting Project (ACRP); 02/26/97
+1 ;;5.3;Scheduling;**99**;Aug 13, 1993
+2 ;
CQ ;Queue re-calculation of OUTPATIENT ENCOUNTER checkout status
+1 ;
+2 ; Variable List
+3 ; SCBDT - Beginning date for search in Outpatient Encounter file
+4 ; SCDT - Outpatient Encounter date
+5 ; SCE0 - Zero node of the outpatient encounter
+6 ; OEIN - IEN of the outpatient encounter
+7 ; SCLINE - Dashed line for report
+8 ; SCPNOW - External date
+9 ; SCEDT - Ending date for search in Outpatient Encounter file
+10 ; PAGE - Number of pages
+11 ; SCCT - Count of entries processed
+12 ;
+13 WRITE !!,"This option will check outpatient encouters with a status of 'CHECKED OUT'"
+14 WRITE !,"for a entry in the TRANSMITTED OUTPATIENT ENCOUNTER file."
+15 WRITE !,"If no entry exists, and the encounter is for a COUNT Clinic, then "
+16 WRITE !,"a transmission entry will be added."
+17 WRITE !!,"This may take a while, please queue to a printer!",!
+18 ;
+19 NEW SCBDT,SCEDT,SCPFLG
+20 SET SCBDT=$$ASKDT("Beginning")
+21 if SCBDT<0
QUIT
CQ1 SET SCEDT=$$ASKDT("Ending")
+1 if SCEDT<0
QUIT
+2 IF SCEDT<SCBDT
Begin DoDot:1
+3 WRITE !!,"Ending date cannot be earlier than the Beginning date!",!
End DoDot:1
GOTO CQ1
+4 ;
+5 SET SCPFLG=1
+6 NEW ZTSAVE,%ZIS
+7 SET %ZIS=0
SET ZTSAVE("SCBDT")=""
SET ZTSAVE("SCEDT")=""
SET ZTSAVE("SCPFLG")=""
+8 DO EN^XUTMDEVQ("CALC^SCDXSUP","Update Checkout Status",.ZTSAVE,.%ZIS)
+9 QUIT
+10 ;
CQAPI(SCBG,SCED,SCPFLG) ; API entry point for re-calculation of OUTPATIENT ENCOUNTER checkout status
+1 ; INPUT:
+2 ; SCBG - Beginning date, if passed in, use it
+3 ; SCED - Ending date, if passed in, use it
+4 ; SCPFLG - Print Report flag
+5 ; 1 - Print report
+6 ; 0 - Do not print report
+7 ;
+8 SET SCBDT=$GET(SCBG)
+9 SET SCEDT=$GET(SCED)
+10 ;
CALC ;Update Checkout Status
+1 ;
+2 NEW SCDT,OEIN,SCPNOW,SCLINE,SCE0,SCCT,SCABRT
+3 ;
+4 KILL ^TMP("SCMSC",$JOB)
+5 ;
+6 ; ** Order through the Outpatatient Encounter file, if the encounter is the parent, evaluate it.
+7 SET SCDT=SCBDT-.1
+8 FOR
SET SCDT=$ORDER(^SCE("B",SCDT))
if 'SCDT!(SCDT>(SCEDT+.99999))
QUIT
Begin DoDot:1
+9 SET OEIN=0
FOR
SET OEIN=$ORDER(^SCE("B",SCDT,OEIN))
if 'OEIN
QUIT
Begin DoDot:2
+10 SET SCE0=$GET(^SCE(OEIN,0))
+11 ; ** The following code removes any extraneous 'B' xrefs found that do not
+12 ; point to a valid entry
+13 IF SCE0']""
Begin DoDot:3
+14 KILL ^SCE("B",SCDT,OEIN)
End DoDot:3
QUIT
+15 IF '$PIECE(SCE0,U,6)
DO EVAL(SCE0,OEIN,SCDT)
End DoDot:2
End DoDot:1
+16 ;
+17 if '$GET(SCPFLG)
GOTO EXIT
+18 ;
+19 ; ** Prepare report output
+20 SET SCLINE=""
SET $PIECE(SCLINE,"-",(IOM+1))=""
+21 SET SCPNOW=$PIECE($$FMTE^XLFDT($$NOW^XLFDT()),":",1,2)
+22 SET SCBDT=$$FMTE^XLFDT(SCBDT)
+23 SET SCEDT=$$FMTE^XLFDT(SCEDT)
+24 SET PAGE=1
SET SCCT=0
+25 ;
CRTX ;
+1 SET SCHD="MISSING TRANSMISSION RECORDS CREATED"
+2 DO HDR
+3 IF '$DATA(^TMP("SCMSC",$JOB,2))
Begin DoDot:1
+4 WRITE !!,"No encounters with missing transmission records found."
End DoDot:1
GOTO NEXT1
+5 ;
+6 SET (SCDT,SCCT)=0
+7 FOR
SET SCDT=$ORDER(^TMP("SCMSC",$JOB,2,SCDT))
if 'SCDT
QUIT
Begin DoDot:1
+8 SET OEIN=0
FOR
SET OEIN=$ORDER(^TMP("SCMSC",$JOB,2,SCDT,OEIN))
if 'OEIN
QUIT
Begin DoDot:2
+9 SET SCE0=^TMP("SCMSC",$JOB,2,SCDT,OEIN)
DO PRT(SCE0)
End DoDot:2
if $GET(SCABRT)
QUIT
End DoDot:1
if $GET(SCABRT)
QUIT
+10 ;
+11 IF $Y>(IOSL-5)
if $$NEWPAGE
DO HDR
+12 WRITE !!,SCCT," transmission record",$SELECT(SCCT=1:"",1:"s")," created."
+13 ;
NEXT1 ;
+1 SET SCHD="COUNT CLINIC ENCOUNTERS SET FOR RETRANSMIT"
+2 SET X=$$NEWPAGE
if $GET(SCABRT)
QUIT
+3 SET PAGE=1
+4 if '(IOST?1"C-".E)
WRITE @IOF
+5 DO HDR
+6 IF '$DATA(^TMP("SCMSC",$JOB,3))
Begin DoDot:1
+7 WRITE !!,"No Count Clinic encounters found needing retransmission."
End DoDot:1
GOTO EXIT
+8 ;
+9 SET (SCDT,SCCT)=0
+10 FOR
SET SCDT=$ORDER(^TMP("SCMSC",$JOB,3,SCDT))
if 'SCDT
QUIT
Begin DoDot:1
+11 SET OEIN=0
FOR
SET OEIN=$ORDER(^TMP("SCMSC",$JOB,3,SCDT,OEIN))
if 'OEIN
QUIT
Begin DoDot:2
+12 SET SCE0=^TMP("SCMSC",$JOB,3,SCDT,OEIN)
DO PRT(SCE0)
End DoDot:2
if $GET(SCABRT)
QUIT
End DoDot:1
if $GET(SCABRT)
QUIT
+13 ;
+14 if $Y>(IOSL-5)
DO HDR
WRITE !!,SCCT," Count clinic encounters marked for retransmission."
+15 ;
EXIT ;
+1 KILL %ZIS,SCHD,PAGE,SCEDT,SCBDT,SCPT0
+2 KILL ^TMP("SCMSC",$JOB)
+3 QUIT
+4 ;
EVAL(SC0,OEIN,SDT) ;Evaluate checkout status
+1 ; ** If the encounter appt. status is CHECKED OUT, and the check out process is
+2 ; completed, but there is no entry for the encounter in the Transmitted
+3 ; Outpatient Encounter file, then process the encounter into the Transmitted
+4 ; Outpatient Encounter File, #409.73
+5 ;
+6 ; If clinic is NON-COUNT and Checked out, then change STATUS field, #.12, from
+7 ; CHECKED OUT to NON-COUNT and exit.
+8 ;
+9 ; Input:
+10 ; SC0 - 0 node of the Outpatient encounter
+11 ; OEIN - IEN of the Outpatient encounter
+12 ; SDT - Date of the Outpatient encounter
+13 ;
+14 ; Output
+15 ; ^TMP("SCMSC",$J,n,SDT,OEIN)=SC0
+16 ;
+17 ; Variables
+18 ; SCTOE - IEN of entry created in the Transmitted Outpatient Encounter file
+19 ; -1 if unable to create entry
+20 ;
+21 NEW SCTOE
+22 IF $PIECE(SC0,U,12)=2
IF $PIECE(SC0,U,7)
IF '$DATA(^SD(409.73,"AENC",OEIN))
Begin DoDot:1
+23 IF $PIECE($GET(^SC(+$PIECE(SC0,U,4),0)),U,17)="Y"
Begin DoDot:2
+24 SET DA=OEIN
SET DR=".12////12"
SET DIE="^SCE("
+25 DO ^DIE
KILL DIE,DR
End DoDot:2
QUIT
+26 SET SCTOE=$$CRTXMIT^SCDXFU01(OEIN)
+27 IF SCTOE>0
DO STREEVNT^SCDXFU01(SCTOE,1)
DO XMITFLAG^SCDXFU01(SCTOE,0)
SET ^TMP("SCMSC",$JOB,2,SDT,OEIN)=SC0
End DoDot:1
QUIT
+28 ;
+29 IF $PIECE(SC0,U,12)=12
IF $PIECE(SC0,U,7)
Begin DoDot:1
+30 IF $PIECE($GET(^SC(+$PIECE(SC0,U,4),0)),U,17)="Y"
QUIT
+31 SET DA=OEIN
SET DR=".12////2"
SET DIE="^SCE("
+32 DO ^DIE
KILL DIE,DR
+33 SET SCTOE=+$ORDER(^SD(409.73,"AENC",OEIN,0))
+34 IF 'SCTOE
Begin DoDot:2
+35 SET SCTOE=$$CRTXMIT^SCDXFU01(OEIN)
End DoDot:2
+36 IF SCTOE>0
DO STREEVNT^SCDXFU01(SCTOE,1)
DO XMITFLAG^SCDXFU01(SCTOE,0)
SET ^TMP("SCMSC",$JOB,3,SDT,OEIN)=SC0
End DoDot:1
+37 ;
+38 QUIT
+39 ;
HDR ; Header
+1 if PAGE>1
WRITE @IOF
+2 WRITE !,SCLINE,!,?(IOM-($LENGTH(SCHD)+10)\2),"<*> ",SCHD," <*>",!,SCLINE
+3 WRITE !,"For date range ",SCBDT," to ",SCEDT
+4 WRITE !,"Date printed: ",SCPNOW,?(IOM-7-$LENGTH(PAGE)),"Page: ",PAGE,!
+5 ;
+6 WRITE !,"Patient",?21,"SSN",?33,"Appointment",?56,"Clinic",!,SCLINE
+7 SET PAGE=PAGE+1
+8 ;
+9 QUIT
+10 ;
PRT(SC0) ;Print appointment
+1 ;
+2 IF $Y>(IOSL-5)
if $$NEWPAGE
DO HDR
if $GET(SCABRT)
QUIT
+3 SET SCCT=SCCT+1
SET SCPT0=^DPT($PIECE(SC0,U,2),0)
+4 WRITE !,$EXTRACT($PIECE(SCPT0,U),1,18),?21,$PIECE(SCPT0,U,9)
+5 WRITE ?33,$PIECE($$FMTE^XLFDT($PIECE(SC0,U)),":",1,2)
+6 WRITE ?56,$EXTRACT($PIECE($GET(^SC(+$PIECE(SC0,U,4),0)),U),1,(IOM-56))
+7 QUIT
+8 ;
ASKDT(TXT) ; Enter beginning date for searching outpatient encounter file
+1 SET DIR(0)="DA^::EXP"
SET DIR("A")="Enter "_TXT_" date for search: "
+2 SET DIR("?")="^D HELP^%DTC"
+3 SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT())
+4 DO ^DIR
KILL DIR
+5 if $DATA(DIRUT)
SET Y=-1
+6 KILL DIRUT
+7 QUIT Y
+8 ;
NEWPAGE() ; Check device and display prompt for terminals
+1 NEW DIR,SCOK
+2 IF IOST?1"C-".E
Begin DoDot:1
+3 WRITE !
+4 SET DIR(0)="E"
DO ^DIR
SET SCABRT='$GET(Y)
+5 IF 'SCABRT
SET SCOK=1
WRITE @IOF
End DoDot:1
+6 QUIT +$GET(SCOK)
