[628] | 1 | SPNPRT03 ;HIRMFO/WAA- PRINT Patient Listing (state,county) ;8/29/96 15:41
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**1,12,13**;01/02/1997
|
---|
| 3 | ;
|
---|
| 4 | EN1 ; Main Entry Point
|
---|
| 5 | S SPNC=0 ; Line counter
|
---|
| 6 | N SPNLEXIT,SPNIO
|
---|
| 7 | S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
|
---|
| 8 | F SPNG="SPNAEREC","SPNAENXT","SPNETIOL","SPNETPV","SPNHLOI","SPNPCP","SPNDATOC","SPNPAGE","SPNC","SPNNAME","SPNDFN","SPNSTATE","SPNCOU" S:$D(@SPNG) ZTSAVE(SPNG)=""
|
---|
| 9 | W !!,"### This report is designed for 132 column viewing/printing ###"
|
---|
| 10 | W !,"### Set your terminal display to 132 columns ###"
|
---|
| 11 | W !,"### For screen viewing, answer DEVICE prompt with 0;132 ###"
|
---|
| 12 | W !,"### For file capture, answer DEVICE prompt with 0;132;9999 ###"
|
---|
| 13 | W !,"### For a hardcopy, answer with a 132 column printer or subtype ###",!
|
---|
| 14 | D DEVICE^SPNPRTMT("PRINT^SPNPRT03","SCD Patient Listing By State/County",.ZTSAVE) Q:SPNLEXIT
|
---|
| 15 | I SPNIO="Q" D EXIT Q ; Print was Queued
|
---|
| 16 | I IO'="" D PRINT D EXIT Q ; Print was not Queued
|
---|
| 17 | Q
|
---|
| 18 | EXIT ; Exit routine
|
---|
| 19 | K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
|
---|
| 20 | K SPNAEREC,SPNAENXT,SPNHLOI,SPNANS,SPNDATOC,SPNNAME,SPNPCP,SPNC,SPNETIOL,SPNETPV,VA,VAEL,VADM,VAPA,ZTSAVE
|
---|
| 21 | K SPNLEXIT,SPNDFN,SPNG,SPNLPRT
|
---|
| 22 | Q
|
---|
| 23 | PRINT ; Print main Body
|
---|
| 24 | U IO
|
---|
| 25 | K ^TMP($J,"SPN")
|
---|
| 26 | S SPNLEXIT=$G(SPNLEXIT) ; Ensure that the exit is set
|
---|
| 27 | N SPNDFN,SPNX
|
---|
| 28 | W !,"Patient Listing by State and County",?75,"Date: ",$$FMTE^XLFDT($$NOW^XLFDT,"5DZP"),!
|
---|
| 29 | W !,$$REPEAT^XLFSTR("-",132)
|
---|
| 30 | W !,"Patient",?14,"SSN",?27,"DOB",?40,"Eligibility",?57,"Means",?67,"LOI",?72,"Prov.",?78,"Etiology",?97,"Date Occ",?110,"AE Receivd",?122,"AE Next"
|
---|
| 31 | W !,$$REPEAT^XLFSTR("-",132)
|
---|
| 32 | S (SPNDFN,SPNLPRT)=0
|
---|
| 33 | F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
|
---|
| 34 | . Q:SPNLEXIT
|
---|
| 35 | . Q:$G(^SPNL(154,SPNDFN,0))="" ; No Zero node
|
---|
| 36 | . I '$$EN2^SPNPRTMT(SPNDFN) Q ; Patient fail the filters
|
---|
| 37 | . S DFN=SPNDFN D DEM^VADPT
|
---|
| 38 | . D ADD^VADPT
|
---|
| 39 | . I $P(VAPA(5),U,2)=""!($P(VAPA(7),U,2)="") Q
|
---|
| 40 | . S ^TMP($J,"SPN",$P(VAPA(5),U,2),$P(VAPA(7),U,2),VADM(1),SPNDFN)="" ; Sort the data
|
---|
| 41 | . D KVAR^VADPT
|
---|
| 42 | . Q
|
---|
| 43 | I $D(^TMP($J,"SPN")) D Q:SPNLEXIT ; Indicates the report had data
|
---|
| 44 | . N SPNSTATE,SPNCOU,SPNDFN,SPNNAME
|
---|
| 45 | . S SPNSTATE="" F S SPNSTATE=$O(^TMP($J,"SPN",SPNSTATE)) Q:SPNSTATE="" D Q:SPNLEXIT
|
---|
| 46 | .. S SPNCOU="" F S SPNCOU=$O(^TMP($J,"SPN",SPNSTATE,SPNCOU)) Q:SPNCOU="" D Q:SPNLEXIT
|
---|
| 47 | ... S SPNNAME="" F S SPNNAME=$O(^TMP($J,"SPN",SPNSTATE,SPNCOU,SPNNAME)) Q:SPNNAME="" D Q:SPNLEXIT
|
---|
| 48 | .... S SPNDFN=0 F S SPNDFN=$O(^TMP($J,"SPN",SPNSTATE,SPNCOU,SPNNAME,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
|
---|
| 49 | ..... I $E(IOST,1)="C",(IOSL<26) S SPNC=SPNC+1 I SPNC=7 R !!,"Enter RETURN to continue or '^' to exit: ",SPNANS:DTIME
|
---|
| 50 | ..... I $G(SPNANS)="^" S SPNLEXIT=1
|
---|
| 51 | ..... I SPNC=7 S SPNC=0
|
---|
| 52 | ..... D PATIENT(SPNDFN,SPNSTATE,SPNCOU)
|
---|
| 53 | .... Q
|
---|
| 54 | ... Q
|
---|
| 55 | .. Q
|
---|
| 56 | . Q
|
---|
| 57 | E W !," ******* No Data for this report. *******"
|
---|
| 58 | I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
|
---|
| 59 | D CLOSE^SPNPRTMT
|
---|
| 60 | K ^TMP($J,"SPN")
|
---|
| 61 | Q
|
---|
| 62 | PATIENT(SPNDFN,SPNSTATE,SPNCOU) ;PRINT PATIENT DATA
|
---|
| 63 | ;INPUT
|
---|
| 64 | ; SPNDFN = patient DFN
|
---|
| 65 | ; (Opt) SPNSTATE = Patient state of res.
|
---|
| 66 | ; (Opt) SPNCOU = Patient county of res.
|
---|
| 67 | ;
|
---|
| 68 | N SPNX
|
---|
| 69 | S DFN=SPNDFN D DEM^VADPT D ELIG^VADPT ; Get patient data
|
---|
| 70 | S SPNSTATE=$G(SPNSTATE) I SPNSTATE'="" W:SPNSTATE'="" !!,"State: ",SPNSTATE S SPNCOU=$G(SPNCOU) W:SPNCOU'="" ?25,"County: ",SPNCOU
|
---|
| 71 | S SPNHLOI=$$GET^DDSVAL(154,SPNDFN,2.1,"","E")
|
---|
| 72 | S SPNPCP=$$GET^DDSVAL(154,SPNDFN,8.1,"","E")
|
---|
| 73 | ;--- get etiol data
|
---|
| 74 | S SPNETPV="" S SPNETPV=$S($D(^SPNL(154,SPNDFN,"E",1,0)):$P(^SPNL(154,SPNDFN,"E",1,0),U,1),1:10) ; Etiol pointer value - 'OTHER' if missing
|
---|
| 75 | S SPNETIOL="" S SPNETIOL=$P(^SPNL(154.03,SPNETPV,0),U,1)
|
---|
| 76 | S SPNDATOC=$S($D(^SPNL(154,SPNDFN,"E",1,0)):$P(^SPNL(154,SPNDFN,"E",1,0),U,2),1:"") ; etiol date of occurance
|
---|
| 77 | ;--- get annual eval data
|
---|
| 78 | S D0=SPNDFN
|
---|
| 79 | D REC^SPNEVAL S SPNAEREC=X
|
---|
| 80 | D NEXT^SPNEVAL S SPNAENXT=X
|
---|
| 81 | W !,$E(VADM(1),1,12),?14,VA("PID"),?27,$P(VADM(3),U,2),?40,$E($P(VAEL(1),U,2),1,15),?57,$E($P(VAEL(8),U,2),1,8),?67,SPNHLOI
|
---|
| 82 | W ?72,$E(SPNPCP,1,5),?78,$E(SPNETIOL,1,18),?97,$$FMTE^XLFDT(SPNDATOC,"5DZP"),?110,$$FMTE^XLFDT(SPNAEREC,"5DZP"),?122,$$FMTE^XLFDT(SPNAENXT,"5DZP")
|
---|
| 83 | D KVAR^VADPT ; Clean up VA Stuff
|
---|
| 84 | Q
|
---|