[613] | 1 | SPNFAP1 ;SAN/WDE/Print routine for pts with future appt's
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**13,24**;01/02/1997
|
---|
| 3 | ; Prints patients with future appts
|
---|
| 4 | ;
|
---|
| 5 | EN ;
|
---|
| 6 | K ^UTILITY($J)
|
---|
| 7 | S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
|
---|
| 8 | DATE ;
|
---|
| 9 | K %DT
|
---|
| 10 | S Y=DT X ^DD("DD") S SPNDEF=$P(Y,"@",1)
|
---|
| 11 | S %DT("A")="Enter a START date: "
|
---|
| 12 | S %DT("B")=SPNDEF
|
---|
| 13 | S %DT="AE"
|
---|
| 14 | D ^%DT I Y=-1 W !,"Option aborted!" D ZAP Q
|
---|
| 15 | S SPNSTRT=Y
|
---|
| 16 | ;ending date
|
---|
| 17 | S %DT("A")="Enter a ENDING date: "
|
---|
| 18 | S %DT(0)=SPNSTRT
|
---|
| 19 | S X1=SPNSTRT,X2=15 D C^%DTC S Y=X X ^DD("DD") S %DT("B")=$P(Y,"@",1)
|
---|
| 20 | S %DT="AE"
|
---|
| 21 | D ^%DT I Y=-1 W !,"Option aborted!" D ZAP Q
|
---|
| 22 | S SPNEND=Y_.2359
|
---|
| 23 | PROMPT ;
|
---|
| 24 | ;ask if they want only pt in the reg..
|
---|
| 25 | ;ask if they want only pts with a sci indicator in file 2..
|
---|
| 26 | ;ask if they want both, Pts in 154 and pts in 2 with an indicator
|
---|
| 27 | K DIR S DIR(0)="SOM^1:Patients in the Registry only.;2:Patients marked as SCI but not in the Registry.;3:Both."
|
---|
| 28 | D ^DIR
|
---|
| 29 | I (Y="^")!('+Y) D ZAP Q
|
---|
| 30 | S SPNSEL=Y
|
---|
| 31 | S SPNCNT=0
|
---|
| 32 | I SPNSEL'=1 W !!,"This report should be queued to run during off hours.",!
|
---|
| 33 | DEV S ZTSAVE("SPN*")=""
|
---|
| 34 | D DEVICE^SPNPRTMT("JUMPIN^SPNFAP1","Patients with future Appointments",.ZTSAVE) Q:SPNLEXIT
|
---|
| 35 | TASK ;
|
---|
| 36 | I SPNIO="Q" D ZAP Q ;queued from spnprtmt
|
---|
| 37 | JUMPIN ;
|
---|
| 38 | ;
|
---|
| 39 | U IO
|
---|
| 40 | S SPNCNT=0
|
---|
| 41 | I SPNSEL=1 D SCDONLY
|
---|
| 42 | I SPNSEL=1 D PRINT I $E(IOST,1)="P" W @IOF X ^%ZIS("C")
|
---|
| 43 | I SPNSEL=1 I $E(IOST,1)="C" I SPNLEXIT'=1 N DIR S DIR(0)="E" D ^DIR W @IOF Q
|
---|
| 44 | I SPNSEL=1 G ZAP Q:SPNLEXIT=1
|
---|
| 45 | D BOTH D PRINT X ^%ZIS("C")
|
---|
| 46 | I $E(IOST,1)="C" I SPNLEXIT'=1 N DIR S DIR(0)="E" D ^DIR W @IOF Q
|
---|
| 47 | D ZAP
|
---|
| 48 | K SPNLEXIT
|
---|
| 49 | Q
|
---|
| 50 | ZAP ;****************************************************************
|
---|
| 51 | K ^UTILITY($J),SPNEND,SPNSTRT,SPNSEL,Y,X,SPNDFN,SPNP2,SPNP3,SPNP4
|
---|
| 52 | K SPNA,SPNQ,SPNIO,SPNCNT,SPNDFN,DATA,SPNCHK,SPNAPPT
|
---|
| 53 | K SPNCL,SPNDT,SPNDATA,SPNTIM,SPNSSN,SPNPT
|
---|
| 54 | K SDARRAY,SDCOUNT,SDDATE,SDCLIEN
|
---|
| 55 | K %DT,SPNTAB
|
---|
| 56 | Q
|
---|
| 57 | SCDONLY S SPNDFN=0,DATA="" F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:(SPNDFN="")!('+SPNDFN) D
|
---|
| 58 | .I '$$EN2^SPNPRTMT(SPNDFN) Q
|
---|
| 59 | .D APPT
|
---|
| 60 | Q
|
---|
| 61 | ;--------------------------------------------------------------------
|
---|
| 62 | BOTH ;
|
---|
| 63 | S SPNDFN=0 F S SPNDFN=$O(^DPT(SPNDFN)) Q:(SPNDFN="")!('+SPNDFN) D
|
---|
| 64 | .I SPNSEL=3 I $D(^SPNL(154,SPNDFN,0)) Q:'$$EN2^SPNPRTMT(SPNDFN) D APPT Q
|
---|
| 65 | .S SPNCHK=$P($G(^DPT(SPNDFN,57)),U,4) I +SPNCHK D APPT
|
---|
| 66 | .I $E(IOST,1)="C" I SPNDFN#100=62 W "."
|
---|
| 67 | .Q
|
---|
| 68 | Q
|
---|
| 69 | ;---------------------------------------------------------------------
|
---|
| 70 | APPT ;
|
---|
| 71 | I SPNSEL=2 Q:$D(^SPNL(154,SPNDFN,0)) ;pt file only pt is in 154
|
---|
| 72 | S SPNCNT=SPNCNT+1 I $E(IOST,1)="C" I SPNCNT#10=0 W "."
|
---|
| 73 | S SDARRAY(1)=SPNSTRT_";"_SPNEND
|
---|
| 74 | S SDARRAY(3)="R"
|
---|
| 75 | S SDARRAY(4)=SPNDFN
|
---|
| 76 | S SDARRAY("FLDS")="1;2"
|
---|
| 77 | S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
|
---|
| 78 | I SDCOUNT>0 D
|
---|
| 79 | .S SDCLIEN=0 F S SDCLIEN=$O(^TMP($J,"SDAMA301",SPNDFN,SDCLIEN)) Q:'+SDCLIEN D
|
---|
| 80 | ..S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SPNDFN,SDCLIEN,SDDATE)) Q:'+SDDATE D
|
---|
| 81 | ...S SDAPPT=$G(^TMP($J,"SDAMA301",SPNDFN,SDCLIEN,SDDATE))
|
---|
| 82 | ...S SPNAPPT=$P($G(^TMP($J,"SDAMA301",SPNDFN,SDCLIEN,SDDATE)),U,1)
|
---|
| 83 | ...S SPNCL=$P(SDAPPT,U,2) S SPNCL=$P(SPNCL,";",2)
|
---|
| 84 | ...Q
|
---|
| 85 | ..Q
|
---|
| 86 | .I SPNSEL'=2 S SPNP2=$E($$GET1^DIQ(154,SPNDFN_",",.03),1,13),SPNP3=$E($$GET1^DIQ(154,SPNDFN_",",2.1),1,3),SPNP4=$E($$GET1^DIQ(154,SPNDFN_",",1.1),1,3)
|
---|
| 87 | .I SPNSEL=2 S SPNP2="",SPNP3="",SPNP4=""
|
---|
| 88 | .S ^UTILITY($J,$P(SPNAPPT,".",1),SPNAPPT,SPNCL,$P(^DPT(SPNDFN,0),U,1),$P(^DPT(SPNDFN,0),U,9))=SPNAPPT_"^"_SPNP2_"^"_SPNP3_"^"_SPNP4
|
---|
| 89 | .S ^UTILITY($J,$P(SPNAPPT,".",1))=""
|
---|
| 90 | I SDCOUNT<0 D
|
---|
| 91 | .I $D(^TMP($J,"SDAMA301",101)) W !!,"Database unavailable. Try later."
|
---|
| 92 | .I $D(^TMP($J,"SDAMA301",116)) W !!,"Pt doesn't exist in Vista system."
|
---|
| 93 | .Q
|
---|
| 94 | I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
|
---|
| 95 | Q
|
---|
| 96 | PRINT ;
|
---|
| 97 | S SPNPA=1
|
---|
| 98 | S Y=SPNSTRT X ^DD("DD") S SPNSTRT=Y S Y=SPNEND X ^DD("DD") S SPNEND=Y
|
---|
| 99 | K Y
|
---|
| 100 | D HDR
|
---|
| 101 | I '$D(^UTILITY($J)) D
|
---|
| 102 | .W !,"-----------------------------------------------------------------------------"
|
---|
| 103 | .W !!?10,"**** No Data for this report. ****" D Q
|
---|
| 104 | .I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
|
---|
| 105 | .D CLOSE^SPNPRTMT
|
---|
| 106 | .Q
|
---|
| 107 | S SPNDT=0 F S SPNDT=$O(^UTILITY($J,SPNDT)) Q:(SPNDT="")!('+SPNDT) D P1 W !
|
---|
| 108 | Q
|
---|
| 109 | ;----------------------------------------------------------------------
|
---|
| 110 | P1 ;Get times of the appts for the given day
|
---|
| 111 | S Y=SPNDT X ^DD("DD") W !,Y S Y="" W !,"-----------------------------------------------------------------------------"
|
---|
| 112 | S SPNTIM=0 F S SPNTIM=$O(^UTILITY($J,SPNDT,SPNTIM)) Q:(SPNTIM="")!('+SPNTIM) D P2
|
---|
| 113 | Q
|
---|
| 114 | P2 ;Get clinic
|
---|
| 115 | S SPNCL="" F S SPNCL=$O(^UTILITY($J,SPNDT,SPNTIM,SPNCL)) Q:SPNCL="" D P3
|
---|
| 116 | Q
|
---|
| 117 | ;
|
---|
| 118 | P3 ;
|
---|
| 119 | S SPNPT="" F S SPNPT=$O(^UTILITY($J,SPNDT,SPNTIM,SPNCL,SPNPT)) Q:SPNPT="" S SPNSSN=0 F S SPNSSN=$O(^UTILITY($J,SPNDT,SPNTIM,SPNCL,SPNPT,SPNSSN)) Q:(SPNSSN="")!('+SPNSSN) D PRT2
|
---|
| 120 | Q
|
---|
| 121 | PRT2 ;
|
---|
| 122 | S Y=$P(^UTILITY($J,SPNDT,SPNTIM,SPNCL,SPNPT,SPNSSN),U,1) X ^DD("DD")
|
---|
| 123 | W !,$P(Y,"@",2)
|
---|
| 124 | W ?7,$E(SPNCL,1,20)
|
---|
| 125 | W ?28,$E(SPNPT,1,17),?46,$E(SPNSSN,6,9)
|
---|
| 126 | W ?53,$P(^UTILITY($J,SPNDT,SPNTIM,SPNCL,SPNPT,SPNSSN),U,2)
|
---|
| 127 | W ?67,$P(^UTILITY($J,SPNDT,SPNTIM,SPNCL,SPNPT,SPNSSN),U,3)
|
---|
| 128 | W ?73,$P(^UTILITY($J,SPNDT,SPNTIM,SPNCL,SPNPT,SPNSSN),U,4)
|
---|
| 129 | I $Y>(IOSL-5) D HDR I SPNLEXIT S (SPNDT,SPNTIM,SPNCL,SPNCL,SPNSSN)="END" Q
|
---|
| 130 | Q
|
---|
| 131 | HDR ;
|
---|
| 132 | I $E(IOST,1)="P" I SPNPA'=1 W #
|
---|
| 133 | I $E(IOST,1)="C" D Q:SPNLEXIT
|
---|
| 134 | .I SPNPA=1 W @IOF Q
|
---|
| 135 | .I SPNPA'=1 D Q:SPNLEXIT
|
---|
| 136 | ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
|
---|
| 137 | ..K Y
|
---|
| 138 | ..W @IOF
|
---|
| 139 | ..Q
|
---|
| 140 | .Q
|
---|
| 141 | Q:SPNLEXIT
|
---|
| 142 | S SPNTAB=$S(SPNSEL=1:18,SPNSEL=2:12,1:2)
|
---|
| 143 | W !?SPNTAB,$S(SPNSEL=1:"Patients in the Registry only",SPNSEL=2:"Patients marked as SCI but not in the Registry",1:"Combined report -- Pts in Registry AND Pts marked as SCI but not in Registry")
|
---|
| 144 | W !?18,"Listing appointments from ",?72,"Page: ",SPNPA
|
---|
| 145 | W !?15,SPNSTRT," to ",SPNEND,!
|
---|
| 146 | W !,"Appointment date"
|
---|
| 147 | W !,"Time",?7,"Clinic",?28,"Patient",?46,"SSN",?53,"Reg",?67,"SCI",?73,"SCI"
|
---|
| 148 | W !,?53,"Status",?67,"LVL",?71,"NETWRK"
|
---|
| 149 | I SPNPA'=1 W !,"-----------------------------------------------------------------------------"
|
---|
| 150 | S SPNPA=SPNPA+1
|
---|