source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRT13.m@ 1397

SPNPRT13 ;SD/CM- PRINT ADMISSIONS REPORT BY DATE RANGE ;8/29/2000
 ;;2.0;Spinal Cord Dysfunction;**13,21**;01/02/1997
EN1 ; Main Entry Point
 N SPNLEXIT,SPNIO,SPNPAGE,SPNDATE,SPNEDAT S SPNPAGE=1
 S SPNLEXIT=0,U="^"
 S SPNA="   Enter START Date: "
 S SPNQ=" Enter the earliest date of Admission for the print to START at."
 D QUEST^SPNPRT04("DA^:NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
 S SPNDATE=Y
 S ZTSAVE("SPN*")=""
 S SPNA="   Enter END Date: "
 S SPNQ=" Enter the latest date of Admission for the print to END with."
 D QUEST^SPNPRT04("DA^"_SPNDATE_":NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
 S SPNEDAT=Y
 D DEVICE^SPNPRTMT("PRINT^SPNPRT13","SCD Admissions",.ZTSAVE) Q:SPNLEXIT
 I SPNIO="Q" D EXIT Q  ; Print was Queued
 I IO'="" D PRINT D EXIT Q  ; Print was not Queued
 Q
EXIT ; Exit routine 
 K ^TMP($J,"SPN")
 K SPNA,SPNIEN,SPNLPRT,SPNQ,SPNQDAT,SPNDATE,VADM,VAIP,ZTSAVE
 Q
PRINT ; Print main Body
 U IO
 K ^TMP($J,"SPN")
 S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
 N SPNDFN,SPNX
 S (SPNDFN,SPNLPRT)=0
 S SPNQDAT=SPNDATE-.000001
 Q:SPNLEXIT
 S SPNQDAT=SPNDATE-000001 F  S SPNQDAT=$O(^DGPM("B",SPNQDAT)) Q:'+SPNQDAT  Q:(SPNQDAT>SPNEDAT)  D  Q:SPNLEXIT
 . S SPNIEN=0 F  S SPNIEN=$O(^DGPM("B",SPNQDAT,SPNIEN)) Q:'+SPNIEN  D:$P($G(^DGPM(SPNIEN,0)),U,2)=1  Q:SPNLEXIT
 .. S SPNDFN=$P(^DGPM(SPNIEN,0),U,3)
 .. N DFN,SPNLINE
 .. I '$D(^SPNL(154,SPNDFN,0)),'(+$$GET1^DIQ(2,SPNDFN,57.4,"I")) Q
 .. S DFN=SPNDFN,VAIP("E")=SPNIEN D IN5^VADPT
 .. ; SPNLINE=Admission date(E)^Ward location(E)^Room-Bed(E)^Adm date^Pointer to PTF
 .. S SPNLINE=$P(VAIP(3),U,1)_U_$P(VAIP(5),U,2)_U_$P(VAIP(6),U,2)_U_SPNQDAT_U_VAIP(12)
 .. S ^TMP($J,"SPN",$$GET1^DIQ(2,SPNDFN,.01,"E"),SPNDFN,SPNIEN)=SPNLINE
 .. D KVAR^VADPT
 .. Q
 . Q
 I $D(^TMP($J,"SPN")) D  Q:SPNLEXIT  ; Indicates the report had data
 . N SPNDFN,SPNNAME,SPNCOU
 . S SPNCOU=0
 . S SPNNAME="" F  S SPNNAME=$O(^TMP($J,"SPN",SPNNAME)) Q:SPNNAME=""  D  Q:SPNLEXIT
 .. S SPNDFN=0 F  S SPNDFN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN)) Q:SPNDFN<1  D NEWPAT(SPNDFN) Q:SPNLEXIT  D  Q:SPNLEXIT  W !
 ... S SPNIEN=0 F  S SPNIEN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN,SPNIEN)) Q:SPNIEN<1  D  Q:SPNLEXIT
 .... S SPNLINE=^TMP($J,"SPN",SPNNAME,SPNDFN,SPNIEN)
 ... D HEAD Q:SPNLEXIT
 ... D PATIENT(SPNDFN,SPNLINE) Q:SPNLEXIT
 ... Q
 .. Q
 .I SPNCOU D
 .. W !,?15,SPNCOU," Patients have been processed."
 .. Q
 . Q
 E  W !,"     ******* No Data for this report. *******"
 I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR  K Y
 D CLOSE^SPNPRTMT
 K ^TMP($J,"SPN")
 Q
NEWPAT(SPNDFN) ; New patient to print
 D HEAD Q:SPNLEXIT
 N DFN
 S DFN=SPNDFN D DEM^VADPT
 W !!,"  Patient: ",$E(VADM(1),1,18),?32,"SSN: ",$P(VADM(2),U),?49,"SCI: ",$E($$GET1^DIQ(2,SPNDFN,57.4,"E"),1,30)
 D KVAR^VADPT
 S SPNCOU=SPNCOU+1
 I '$D(^SPNL(154,SPNDFN,0)) Q
 I $O(^SPNL(154,SPNDFN,"E",0))<1 Q
 N SPNETI,SPNDFLG
 S (SPNETI,SPNDFLG)=0 W !,"  Etiology: "
 F  S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI)) Q:SPNETI<1  D  Q:SPNLEXIT
 .N SPNETO
 .S SPNETO=$P($G(^SPNL(154,SPNDFN,"E",SPNETI,0)),U) Q:SPNETO=""
 .I $X>13 D HEAD Q:SPNLEXIT  W !
 .W ?12,$E($$GET^DDSVAL(154.03,SPNETO,.01,"","E"),1,30)
 .I 'SPNDFLG W ?49,"Registration Date: ",$$FMTE^XLFDT($P($G(^SPNL(154,SPNDFN,0)),U,2),"5DZ") S SPNDFLG=1
 .Q
 Q
PATIENT(SPNDFN,SPNLINE) ; Print Patient data
 ; SPNLINE=Movement date(I)^Ward location(E)^Room-Bed(E)^Adm Date^Pointer to PTF
 ; SPNLINE=$P(VAIP(3),U,1)_U_VAIP(5),U,2)_U_$P(VAIP(6),U,2)_U_SPNQDAT_U_VAIP(12)
 Q:SPNLEXIT
 W !,$$FMTE^XLFDT($P(SPNLINE,U,1),"5Z"),?22,$E($P(SPNLINE,U,2),1,14),?37,$E($P(SPNLINE,U,3),1,15)
 Q:$P(SPNLINE,U,2)=""
 N SPNODE,SPNNODE
 S SPNNODE=$G(^DGPT($P(SPNLINE,U,5),70)) Q:SPNNODE=""
 N SPNY
 F SPNODE=10,16:1:24 D  Q:SPNLEXIT
 .S SPNY=$P(SPNNODE,U,SPNODE)
 .I SPNY'>0 Q
 .I $G(^ICD9(SPNY,0))="" Q
 .I $X>50 D HEAD Q:SPNLEXIT  W !
 .W ?50,$E($$GET1^DIQ(80,SPNY,3,"E"),1,29)
 .Q
 I '$D(^SPNL(154,SPNDFN,0)) W !?2,"*** NOT IN THE REGISTRY ! ***"
 Q
HEAD ; Header Print
 I SPNPAGE'=1 Q:$Y<(IOSL-4)
 I $E(IOST,1)="C" D  Q:SPNLEXIT
 .I SPNPAGE=1 W @IOF Q
 .I SPNPAGE'=1 D  Q:SPNLEXIT
 ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
 ..K Y
 ..Q
 .Q
 Q:SPNLEXIT
 I SPNPAGE'=1 W @IOF
 W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
 W !!,?27,"SCD Admissions"
 W !,?27,"From ",$$FMTE^XLFDT(SPNDATE,"5DZ")," to ",$$FMTE^XLFDT(SPNEDAT,"5DZ")
 W !!,"Date Admitted",?22,"Ward",?37,"Room-Bed",?50,"Diagnosis Codes"
 W !,$$REPEAT^XLFSTR("-",79)
 S SPNPAGE=SPNPAGE+1
 I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
 Q