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

APCLYV52.m

Go to the documentation of this file.
  1. APCLYV52 ; IHS/CMI/LAB - PRINT INPATIENT VISITS ;
  1. ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1. ;
  1. ;cmi/anch/maw 9/12/2007 code set versioning POV,PRC
  1. ;
  1. INIT ;initialize variables
  1. I '$D(^XTMP("APCLYV5",APCLJOB,APCLBTH,"VISITS")) S APCLPAGE=0 D HEAD W !!,"No Hospitaliations to report." G END
  1. S APCLSTOP="",APCLPAGE=0
  1. S (APCLPTOT,APCLVTOT)=0 ;patient and visit counts
  1. ;
  1. SET ;
  1. S APCLSORT=0 D HEAD
  1. SET1 S APCLSORT=$O(^XTMP("APCLYV5",APCLJOB,APCLBTH,"VISITS",APCLSORT)) G FINAL:APCLSORT="" S APCLDFN=0
  1. SET2 S APCLDFN=$O(^XTMP("APCLYV5",APCLJOB,APCLBTH,"VISITS",APCLSORT,APCLDFN)) G SET1:APCLDFN=""
  1. S (APCLDDT,APCLFVS)=0
  1. ;set and print demographic data
  1. S APCLPTOT=APCLPTOT+1
  1. I $G(APCLLOC)]"",$D(^AUPNPAT(APCLDFN,41,APCLLOC,0)) S APCLHRCN=$P(^AUPNPAT(APCLDFN,41,APCLLOC,0),U,2) G SET21
  1. S APCLHRCN=$S($D(^AUPNPAT(APCLDFN,41,DUZ(2),0)):$P(^(0),U,2),1:"")
  1. SET21 K ^UTILITY("DIQ1",$J) S DIC=9000001,DA=APCLDFN,DR=1102.99 D EN^DIQ1
  1. S APCLNAME=$P(^DPT(APCLDFN,0),U)
  1. S APCLAGE=$G(^UTILITY("DIQ1",$J,9000001,APCLDFN,1102.99)) K ^UTILITY("DIQ1",$J)
  1. I $Y>(IOSL-5) D PAGE G END:APCLSTOP="^"
  1. W !,$E(APCLNAME,1,15),?16,$J(APCLHRCN,6),?24,$J(APCLAGE,2)
  1. ;
  1. ;find visit
  1. SET3 S APCLDDT=$O(^XTMP("APCLYV5",APCLJOB,APCLBTH,"VISITS",APCLSORT,APCLDFN,APCLDDT)) G SET2:APCLDDT="" S APCLVDFN=$P(^(APCLDDT),"^"),APCLVDT=$P(^(APCLDDT),"^",2)
  1. S APCLVTOT=APCLVTOT+1 ;increment visit count
  1. I APCLFVS W ! I $Y>(IOSL-5) D PAGE G END:APCLSTOP="^"
  1. S APCLFPV=0,APCLFVS=1
  1. W ?27,$E(APCLVDT,4,5),"/",$E(APCLVDT,6,7),"/",$E(APCLVDT,2,3)
  1. W "-",$E(APCLDDT,4,5),"/",$E(APCLDDT,6,7),"/",$E(APCLDDT,2,3)
  1. ;
  1. ;set and print provider class code
  1. S APCLPRV=0
  1. PRV S APCLPRV=$O(^AUPNVPRV("AD",APCLVDFN,APCLPRV))
  1. I APCLPRV="" S APCLPV=0 G POV
  1. G PRV:'$D(^AUPNVPRV(APCLPRV,0)),PRV:$P(^(0),"^",4)'="P"
  1. S X=+^AUPNVPRV(APCLPRV,0)
  1. S APCLCLS=$$PROVCLSC^XBFUNC1(X)
  1. PRV1 W ?46,APCLCLS
  1. ;
  1. S APCLPV=0
  1. POV S APCLPV=$O(^AUPNVPOV("AD",APCLVDFN,APCLPV))
  1. I APCLPV="" S APCLVPRC=0 G PRC
  1. G POV:'$D(^AUPNVPOV(APCLPV,0)) S APCLSTR=^(0)
  1. S APCLVRV=$P(APCLSTR,"^",8),APCLPS=$P(APCLSTR,"^",12)
  1. S APCLVPOV=+APCLSTR,APCLNAR=$P(APCLSTR,"^",4)
  1. S APCLVPOV=$S(APCLVPOV="":"",1:$P($$ICDDX^ICDEX(APCLVPOV),"^",2)) ;cmi/anch/maw 9/12/2007 csv
  1. S APCLNAR=$$VAL^XBDIQ1(9000010.07,APCLPV,.04) ;$S(APCLNAR="":"",$D(^AUTNPOV(APCLNAR,0)):$P(^(0),"^"),1:"")
  1. I APCLFPV W ! I $Y>(IOSL-5) D PAGE G END:APCLSTOP="^" W !
  1. I 'APCLFPV S APCLFPV=1
  1. W ?51,APCLVPOV,?61,$E(APCLNAR,1,18)
  1. G POV
  1. ;
  1. ;set and print procedures
  1. PRC S APCLVPRC=$O(^AUPNVPRC("AD",APCLVDFN,APCLVPRC))
  1. I APCLVPRC="" W ! G SET3
  1. G PRC:'$D(^AUPNVPRC(APCLVPRC,0)) S APCLSTR=^(0)
  1. S APCLVRV=$P(APCLSTR,"^",8),APCLPS=$P(APCLSTR,"^",12)
  1. S APCLPRC=+APCLSTR,APCLNAR=$P(APCLSTR,"^",4)
  1. ;S APCLPRC=$S(APCLPRC="":"",1:$P(^ICD0(APCLPRC,0),"^")) ;cmi/anch/maw 9/12/2007 orig line
  1. S APCLPRC=$S(APCLPRC="":"",1:$P($$ICDOP^ICDEX(APCLPRC,,,"I"),"^",2)) ;cmi/anch/maw 9/12/2007 csv
  1. S APCLNAR=$S(APCLNAR="":"",$D(^AUTNPOV(APCLNAR,0)):$P(^(0),"^"),1:"")
  1. I APCLFPV W ! I $Y>(IOSL-5) D PAGE G END:APCLSTOP="^" W !
  1. I 'APCLFPV S APCLFPV=1
  1. W ?51,APCLPRC,?61,$E(APCLNAR,1,18)
  1. G PRC
  1. ;
  1. FINAL ;
  1. I $Y>(IOSL-5) D PAGE
  1. W !!?39,"TOTAL PATIENTS: ",APCLPTOT
  1. W !!?41,"TOTAL VISITS: ",APCLVTOT
  1. I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLSTOP="^" G END
  1. END ;
  1. D DONE^APCLOSUT
  1. K APCL65,APCLBD,APCLCLS,APCLED,APCLFPV,APCLFVS,APCLIOM,APCLMCR,%DT,%Y,%T,APCLAGE,DA,APCLDFN,APCLDDT,APCLIDFN,G,POP,APCLNAME
  1. K APCLSORT,APCLNAR,APCLPRC,APCLPRV,APCLPS,APCLPTOT,APCLPV,A,APCLSTR
  1. K APCLSTOP,APCLVDFN,APCLVDT,APCLVPOV,APCLVPRC,APCLVRV,APCLVTOT,Y
  1. K APCLVTOT,APCLPAGE,APCLICD,APCLBICD,APCLEICD,APCLPV,APCLPRC,APCLFLG,APCLLOC
  1. K ^XTMP("APCLYV5",APCLJOB,APCLBTH,"VISITS"),^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD") Q
  1. ;
  1. W:$D(IOF) @IOF,!?11,"*****Confidential Patient Data Covered by Privacy Act*****",!
  1. S X=$P(^DIC(4,APCLLOC,0),"^"),APCLPAGE=APCLPAGE+1
  1. W !!,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?70,"Page ",APCLPAGE
  1. S X=$P($H,",",2) D TIME W !,Y,?27,"HOSPITALIZATION ",APCLTITL
  1. S Y=DT X ^DD("DD") W !,Y
  1. W ?26,"for ",$E(APCLBD,4,5),"/",$E(APCLBD,6,7),"/",(1700+$E(APCLBD,1,3)) ;IHS/CMI/LAB - 4 digit year
  1. W " to ",$E(APCLED,4,5),"/",$E(APCLED,6,7),"/",(1700+$E(APCLED,1,3)) ;IHS/CMI/LAB - 4 digit year
  1. S APCLLENG=$L($S(APCLSV=0:3,1:$P(^DIC(45.7,APCLSV,0),U)))
  1. W !?(80-(22+APCLLENG)/2),$S(APCLSV=0:"ALL",1:$P(^DIC(45.7,APCLSV,0),U))," TREATING SPECIALT"_$S(APCLSV=0:"IES",1:"Y")
  1. W !!,"NAME",?17,"HRCN",?23,"AGE",?28,"VISIT DATES",?46,"PRV",?51,"ICD",?61,"PROV NARRATIVE",!
  1. Q
  1. ;
  1. PAGE ;
  1. I IOST'?1"C-".E D HEAD Q
  1. I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLSTOP="^" Q
  1. I APCLSTOP'="^" D HEAD
  1. Q
  1. TIME NEW %A,%B,%C S Y="" Q:'$D(X) Q:X<0!(X>86400)
  1. S %A=X\60,%B=%A\60 S:%B>12 %B=%B-12 S:%B=0 %B=12 S:%B<10 %B=" "_%B
  1. S %C=$S(%A=0:"M ",%A=720:"N ",%A=1440:"M ",%A<720:"am",1:"pm")
  1. S Y=%B_":"_$E(%A#60+100,2,3)_" "_%C K %A,%B,%C Q