| 1 | SCRPW18 ;RENO/KEITH/MRY - ACRP encounter consistency checker ; 21 JUL 2000  2:17 PM
 | 
|---|
| 2 |  ;;5.3;Scheduling;**139,144,155,222,387,466**;AUG 13, 1993;Build 2
 | 
|---|
| 3 | CHEK(ENCPTR,SDARY,SDSTR) ;Consistency checker for outpatient encounter transactions
 | 
|---|
| 4 |  ;Required input: ENCPTR=OUTPATIENT ENCOUNTER record IEN
 | 
|---|
| 5 |  ;Required input: SDARY=array (passed by reference) of HL7 segments to 
 | 
|---|
| 6 |  ;                check in the format SDARY(segmentname)="".  Returns
 | 
|---|
| 7 |  ;                SDARY(segmentname)="", if no errors for that segment.
 | 
|---|
| 8 |  ;                If errors exist for a specific segment, returns:
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ;  SDARY(segment)="-1^Element in xxx segment failed validity check"
 | 
|---|
| 11 |  ;  SDARY(segment,errorcode)=error code description (from file #409.76)
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  ;                If passed in as an undefined array, all segments will
 | 
|---|
| 14 |  ;                be checked; otherwise, only segment names
 | 
|---|
| 15 |  ;                in the array subscript will be checked.
 | 
|---|
| 16 |  ;Optional input: SDSTR array as established by SEG^SCRPW18
 | 
|---|
| 17 |  ;Output: 1=inconsistencies found, 0=no inconsistencies found
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 |  N HL,HLEID,ENCDT,EVNTDATE,EVNTHL7,SEG,DELPTR,SDERR,DFN,VAFSTR,NODE,SDE1,SDI,SDX,VALERR,XMITPTR,ENCNDT S VALERR="SDE1",XMITPTR=""
 | 
|---|
| 20 |  D:$D(SDSTR)<10 STR(.SDSTR) I $D(SDARY)<10 S SEG="" F  S SEG=$O(SDSTR(SEG)) Q:SEG=""  S SDARY(SEG)=""
 | 
|---|
| 21 |  S NODE=$$GETOE^SDOE(ENCPTR) Q:'$L(NODE) 0  S DFN=$P(NODE,U,2)
 | 
|---|
| 22 |  S SDERR=0,DELPTR="",HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0)),ENCDT=$P($P(NODE,U),"."),EVNTDATE=$P(NODE,U),ENCNDT=EVNTDATE,EVNTHL7="A08" D INIT^HLFNC2(HLEID,.HL)
 | 
|---|
| 23 |  S SEG="" F  S SEG=$O(SDARY(SEG)) Q:SEG=""  S VAFSTR=$G(SDSTR(SEG)) I $L(VAFSTR) D VER(SEG,VAFSTR,.SDARY,.SDERR) K @("VAF"_SEG)
 | 
|---|
| 24 |  Q SDERR
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 | VER(SEG,VAFSTR,SDARY,SDERR) ;Verify a segment
 | 
|---|
| 27 |  ;Required input: SEG=segment name
 | 
|---|
| 28 |  ;Required input: VAFSTR=segment string
 | 
|---|
| 29 |  ;Required input: SDARY=array for error return
 | 
|---|
| 30 |  ;Required input: SDERR=variable to return error status (pass by reference)
 | 
|---|
| 31 |  ;Output: SDARY(SEG)=error (if one exists)
 | 
|---|
| 32 |  N VAFARRY,TAG,ERROR,ERRSUB S SDARY(SEG)=""
 | 
|---|
| 33 |  K ^TMP("SCRPWVER",$J) S VAFARRY="^TMP(""SCRPWVER"","_$J_","""_SEG_""")" S ERROR=0 F TAG="BLD"_SEG_"^SCDXMSG1","VLD"_SEG_"^SCDXMSG1" D @TAG
 | 
|---|
| 34 |  K ^TMP("SCRPWVER",$J) I ERROR'=0 S SDARY(SEG)=ERROR,SDERR=1,SDI="" F  S SDI=$O(SDE1(SEG,SDI)) Q:SDI=""  S SDX=SDE1(SEG,SDI),SDARY(SEG,SDX)=$P($G(^SD(409.76,+$O(^SD(409.76,"B",SDX,"")),1)),U)
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 | STR(SDSTR) ;Create segment string
 | 
|---|
| 38 |  ;Required input: SDSEG=array to return segment strings (pass by reference)
 | 
|---|
| 39 |  ;Output: array of segments and strings in the format SDSTR(segment)=segment string
 | 
|---|
| 40 |  N SDI,SDSEG
 | 
|---|
| 41 |  D SEGMENTS^SCDXMSG1("A08","SDSTR") S SDI=0 F  S SDI=$O(SDSTR(SDI)) Q:'SDI  S SDSEG=$O(SDSTR(SDI,"")),SDSTR(SDSEG)=SDSTR(SDI,SDSEG) K SDSTR(SDI,SDSEG)
 | 
|---|
| 42 |  Q
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 | SEGS(SDARY) ;Return segments to validate
 | 
|---|
| 45 |  ;Optional input: SDARY=array to return list of segments in
 | 
|---|
| 46 |  ;Output: string of HL7 segments to validate
 | 
|---|
| 47 |  N SD,SDS,SDL
 | 
|---|
| 48 |  S SDS="PID^ZIR^ZEL^ZPD^ZSP^DG1^PR1^ZCL^ZSC^ROL^"
 | 
|---|
| 49 |  K SDARY F SDL=1:1 S SD=$P(SDS,U,SDL) Q:SD=""  S SDARY(SD)=""
 | 
|---|
| 50 |  Q SDS
 | 
|---|
| 51 |  ;
 | 
|---|
| 52 |  ;Modules to print the Encounter 'Action Required' Report
 | 
|---|
| 53 | DET ;Print detail
 | 
|---|
| 54 |  S SDT(1)="<*>  ENCOUNTER 'ACTION REQUIRED' REPORT  <*>",SDFF=0,SDCG="" F  S SDCG=$O(^TMP("SCRPW",$J,SDIV,1,SDCG)) Q:SDCG=""  D HDR(.SDT,"D") Q:SDOUT  W:SD("FORMAT")="AG" !?2,"Clinic group: ",SDCG D TPRT
 | 
|---|
| 55 |  Q
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 | TPRT S SDCLN="" F  S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN)) Q:SDCLN=""!SDOUT  D:(SDFF&$G(SD("PAGE"))!($Y>(IOSL-6))) HDR(.SDT,"D") Q:SDOUT  W !!?8,"Clinic: ",SDCLN S SDFF=1 D PPRT
 | 
|---|
| 58 |  Q
 | 
|---|
| 59 |  ;
 | 
|---|
| 60 | PPRT S SDORD="" F  S SDORD=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD)) Q:SDORD=""!SDOUT  S DFN="" F  S DFN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN)) Q:DFN=""!SDOUT  D PP1
 | 
|---|
| 61 |  Q
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 | PP1 S SDPT0=^TMP("SCRPW",$J,SDIV,3,DFN),SDPTNA=$P(SDPT0,U),SDSN=$P(SDPT0,U,3)
 | 
|---|
| 64 |  S SDOE=0 F  S SDOE=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE)) Q:'SDOE!SDOUT  S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0) D ETCO,PP2
 | 
|---|
| 65 |  Q
 | 
|---|
| 66 |  ;
 | 
|---|
| 67 | PP2 S SDCT=2,SDI="" F  S SDI=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE,SDI)) Q:SDI=""  S SDCT=SDCT+1
 | 
|---|
| 68 |  D:$Y>(IOSL-SDCT) HDR(.SDT,"D") Q:SDOUT  W !!,$E(SDPTNA,1,24),?26,SDSN S Y=$P(SDOE0,U) X ^DD("DD") W ?39,$P(Y,":",1,2),?58,SDTY,?81,$E(SDCI,1,25),?107,$E(SDCO,1,25),!,?26,"Status: ",$P($G(^SD(409.63,+$P(SDOE0,U,12),0)),U)
 | 
|---|
| 69 |  S SDCT=0,SDI="" F  S SDI=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE,SDI)) Q:SDI=""!SDOUT  D
 | 
|---|
| 70 |  .W ! W:'SDCT ?8,"Required elements:" S SDX=^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE,SDI) W ?27,$$DEF(SDX,104) S SDCT=SDCT+1
 | 
|---|
| 71 |  .Q
 | 
|---|
| 72 |  Q
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | ETCO S (SDTY,SDCI,SDCO)="" D:$P(SDOE0,U,8)=1 ETAP D:$P(SDOE0,U,8)=2 ETAE D:$P(SDOE0,U,8)=3 ETDIS Q
 | 
|---|
| 75 |  ;
 | 
|---|
| 76 | ETDIS S SDTY="DISPOSITION",SDDIS=$P(SDOE0,U,9),SDDIS=$G(^DPT(DFN,"DIS",+SDDIS,0)),SDCI=$P(SDDIS,U,5),SDCI=$P($G(^VA(200,+SDCI,0)),U),SDCO=$P(SDDIS,U,9),SDCO=$P($G(^VA(200,+SDCO,0)),U) Q
 | 
|---|
| 77 |  ;
 | 
|---|
| 78 | ETAP S SDAP0=$G(^DPT(DFN,"S",$P(SDOE0,U),0)) Q:'$L(SDAP0)  S SDCL=$P(SDAP0,U) Q:SDCL'=$P(SDOE0,U,4)
 | 
|---|
| 79 |  S X=$P(SDAP0,U,7),SDTY=$S(X=3:"SCHEDULED APPOINTMENT",X=4:"UNSCHEDULED VISIT",X=2:"10-10 VISIT",X=1:"C&P APPOINTMENT",1:"")
 | 
|---|
| 80 |  S SDCLPT=0 F  S SDCLPT=$O(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT)) Q:'SDCLPT  Q:$P(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT,0),U)=DFN
 | 
|---|
| 81 |  Q:'SDCLPT  I SDTY["UNSCH" S SDCI=$P(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT,0),U,6) S:SDCI SDCI=$P($G(^VA(200,SDCI,0)),U)
 | 
|---|
| 82 |  S SDCLPTC=$G(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT,"C")) Q:'$L(SDCLPTC)  I $P(SDCLPTC,U,2) S SDCI=$P($G(^VA(200,+$P(SDCLPTC,U,2),0)),U)
 | 
|---|
| 83 |  I $P(SDCLPTC,U,4) S SDCO=$P($G(^VA(200,+$P(SDCLPTC,U,4),0)),U)
 | 
|---|
| 84 |  Q
 | 
|---|
| 85 |  ;
 | 
|---|
| 86 | ETAE S SDTY="ADD/EDIT ENCOUNTER",SDV=$P(SDOE0,U,5),SDCO=$P($G(^AUPNVSIT(+SDV,0)),U,23),SDCO=$P($G(^VA(200,+SDCO,0)),U)
 | 
|---|
| 87 |  Q
 | 
|---|
| 88 |  ;
 | 
|---|
| 89 | T2() Q:SD("FORMAT")="AC" "For all clinics"  Q:SD("FORMAT")="SC" "For selected clinics"
 | 
|---|
| 90 |  I SD("FORMAT")="RC" N SDC,SDX S SDC=$O(SD("CLINIC","")),SDX="For range of clinics: "_SDC,SDC=$O(SD("CLINIC",SDC)) Q SDX_" to "_SDC
 | 
|---|
| 91 |  I SD("FORMAT")="SS" N SDX,SDI S SDX="" D  Q SDX
 | 
|---|
| 92 |  .S SDI=0 F  S SDI=$O(SD("STOPCODE",SDI)) Q:'SDI  S SDX=SDX_", "_SDI
 | 
|---|
| 93 |  .S SDI=$S($L(SDX,", ")>11:", <more>",1:"")
 | 
|---|
| 94 |  .S SDX="For selected Stop Codes: "_$P(SDX,", ",2,11)_SDI
 | 
|---|
| 95 |  .Q
 | 
|---|
| 96 |  I SD("FORMAT")="RS" N SDX,SDI S SDI=$O(SD("STOPCODE","")),SDX="For range of Stop Codes: "_SDI,SDI=$O(SD("STOPCODE",SDI)) Q SDX_" to "_SDI
 | 
|---|
| 97 |  Q:SD("FORMAT")="AG" "For all clinic groups"  Q "For clinic group: "_$P(SD("GROUP"),U,2)
 | 
|---|
| 98 |  ;
 | 
|---|
| 99 | HD1 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDLINE="",$P(SDLINE,"-",133)="",Y=SD("BDT") X ^DD("DD") S SDBDAY=Y,Y=$P(SD("EDT"),".") X ^DD("DD") S SDEDAY=Y,SDPAGE=1 Q
 | 
|---|
| 100 |  ;
 | 
|---|
| 101 | HDR(SDT,SDR) ;Print header
 | 
|---|
| 102 |  ;Required input: SDT=array of report titles
 | 
|---|
| 103 |  ;Required input: SDR=report type
 | 
|---|
| 104 |  D STOP^SCRPW16 Q:SDOUT
 | 
|---|
| 105 |  I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
 | 
|---|
| 106 |  N SDI W:SDPAGE'=1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE S SDI=0 F  S SDI=$O(SDT(SDI)) Q:'SDI  W !?(132-$L(SDT(SDI))\2),SDT(SDI)
 | 
|---|
| 107 |  W !,SDLINE,!,"For date range: ",SDBDAY," to ",SDEDAY,!,"Date printed: ",SDPNOW,?(126-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1
 | 
|---|
| 108 |  I SDR="D" W !,"Patient:",?26,"SSN:",?39,"Date/time:",?58,"Type:",?81,"Check-in user:",?107,"Check-out user:",!,SDLINE
 | 
|---|
| 109 |  Q
 | 
|---|
| 110 |  ;
 | 
|---|
| 111 | STAT ;Print statistics
 | 
|---|
| 112 |  S SDT(1)="<*>  ENCOUNTER 'ACTION REQUIRED' STATISTICS  <*>" D HDR(.SDT,"S") S SDCG="" F  S SDCG=$O(^TMP("SCRPW",$J,SDIV,1,SDCG)) Q:SDCG=""  D ST1
 | 
|---|
| 113 |  D:$Y>(IOSL-3) HDR(.SDT,"S") W !!?35,$S(SDIV:"DIVISION",1:"TOTAL")," 'ACTION REQUIRED' ENCOUNTERS IDENTIFIED: ",SDFCT(SDIV) Q
 | 
|---|
| 114 |  ;
 | 
|---|
| 115 | ST1 I SD("FORMAT")["G" D:$Y>(IOSL-7) HDR(.SDT,"S") S SDX="Clinic group: "_SDCG W !!?(132-$L(SDX)\2),SDX,!
 | 
|---|
| 116 |  D REASON D:$Y>(IOSL-4) HDR(.SDT,"S") W !!?35,"Clinic:"
 | 
|---|
| 117 |  S SDCLN="" F  S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN)) Q:SDCLN=""  D:$Y>(IOSL-2) HDR(.SDT,"S") W !?35,SDCLN,?89,$J(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN),6)
 | 
|---|
| 118 |  I SD("FORMAT")["G" D:$Y>(IOSL-3) HDR(.SDT,"S") S SDX="Total for clinic group "_SDCG_": "_^TMP("SCRPW",$J,SDIV,1,SDCG) W !!?(132-$L(SDX)\2),SDX,!?35,$E(SDLINE,1,60),!
 | 
|---|
| 119 |  Q
 | 
|---|
| 120 |  ;
 | 
|---|
| 121 | REASON D:$Y>(IOSL-4) HDR(.SDT,"S") W !?35,"Reason:" S SDI=""
 | 
|---|
| 122 |  F  S SDI=$O(^TMP("SCRPW",$J,SDIV,2,SDCG,SDI)) Q:SDI=""  D:$Y>(IOSL-3) HDR(.SDT,"S") W !?35,$$DEF(SDI,52),?89,$J(^TMP("SCRPW",$J,SDIV,2,SDCG,SDI),6)
 | 
|---|
| 123 |  W ! Q
 | 
|---|
| 124 |  ;
 | 
|---|
| 125 | DEF(SDX,SDL) ;Produce deficiency external value
 | 
|---|
| 126 |  ;Required input: SDX=error code or value
 | 
|---|
| 127 |  ;Required input; SDL=maximum length of output string
 | 
|---|
| 128 |  Q:'$D(^SD(409.76,"B",SDX)) $E(SDX,1,SDL)
 | 
|---|
| 129 |  N SDERR S SDERR=$$ERRSUB^SCRPW17(SDX) I SDERR'="" Q $E(SDERR,1,SDL)
 | 
|---|
| 130 |  N SDV S SDV=$P($G(^SD(409.76,+$O(^SD(409.76,"B",SDX,"")),1)),U)
 | 
|---|
| 131 |  Q $S($L(SDV):$E(SDV,1,SDL),1:$E(SDX,1,SDL))
 | 
|---|