Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCDXSUP

SCDXSUP.m

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