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

APCLYV32.m

Go to the documentation of this file. 
  1. APCLYV32 ; IHS/CMI/LAB - PRINT CLINIC 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 ;
  1.  S APCLSTOP="",APCLPAGE=0
  1.  I '$D(^XTMP("APCLYV3",APCLJOB,APCLBT)) D HEAD W !,"No visits to report."  G END
  1.  S (APCLPGRD,APCLVGRA)=0
  1.  ;
  1. SET ;
  1.  S APCLCLX=0
  1.  F  S APCLCLX=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX)) Q:APCLCLX=""!(APCLSTOP="^")  D SET2
  1.  G:APCLSTOP="^" END
  1.  D FINAL
  1. END ;
  1.  D DONE^APCLOSUT
  1.  K ^XTMP("APCLYV3",APCLJOB,APCLBT)
  1.  Q
  1. SET2 ;
  1.  S (APCLNAME,APCLPTOT,APCLVTOT)=0 D HEAD
  1.  F  S APCLNAME=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME)) Q:APCLNAME=""!(APCLSTOP="^")  S APCLDFN=0 D SET3
  1.  Q:APCLSTOP="^"
  1.  D TOTALS
  1.  Q
  1. SET3 F  S APCLDFN=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN)) Q:APCLDFN=""!(APCLSTOP="^")  D SET4
  1.  Q
  1. SET4 ;
  1.  S (APCLVDT,APCLFVS)=0 ;visit date & first visit flag for line feed
  1.  S APCLPTOT=APCLPTOT+1 ;increment patient count for clinic
  1.  I $G(APCLLOC)]"",$D(^AUPNPAT(APCLDFN,41,APCLLOC,0)) S APCLHRCN=$P(^AUPNPAT(APCLDFN,41,APCLLOC,0),U,2) G SET41
  1.  S APCLHRCN=$S($D(^AUPNPAT(APCLDFN,41,DUZ(2),0)):$P(^(0),U,2),1:"")
  1. SET41 ;
  1.  K ^UTILITY("DIQ1",$J) S DIC=9000001,DA=APCLDFN,DR=1102.99 D EN^DIQ1
  1.  S APCLAGE=$G(^UTILITY("DIQ1",$J,9000001,APCLDFN,1102.99)) K ^UTILITY("DIQ1",$J)
  1.  I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^"
  1.  W !,$E(APCLNAME,1,13),?15,$J(APCLHRCN,6),?23,$J(APCLAGE,2)
  1.  ;
  1.  F  S APCLVDT=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT)) Q:APCLVDT=""  S APCLVDFN=0 D SET5
  1.  Q
  1. SET5 ;
  1.  F  S APCLVDFN=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT,APCLVDFN)) Q:APCLVDFN=""!(APCLSTOP="^")  D PRNT
  1.  Q
  1. PRNT ;
  1.  S APCLVTOT=APCLVTOT+1
  1.  I APCLFVS W ! I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^"
  1.  S APCLFPV=0,APCLFVS=1
  1.  W ?26,$E(APCLVDT,4,5),"/",$E(APCLVDT,6,7),"/",$E(APCLVDT,2,3)_" "_$E($P(APCLVDT,".",2)_"0000",1,4)
  1.  ;
  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.  I $P(^DD(9000010.06,.01,0),U,2)[200 S APCLCLSC=$$PROVCLSC^XBFUNC1(X) W ?41,$E(APCLCLSC,1,3) G PRVJMP
  1.  S X=$P(^DIC(6,X,0),"^",4)
  1.  S APCLCLS=$S(X="":"",'$D(^DIC(7,X,9999999)):"??",1:$P(^DIC(7,X,9999999),"^"))
  1.  W ?41,APCLCLS
  1.  ;
  1.  ;
  1. PRVJMP ;
  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(^ICD9(APCLVPOV,0),"^"))  ;cmi/anch/maw 9/12/2007 orig line
  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 Q:APCLSTOP="^"  W !
  1.  I 'APCLFPV S APCLFPV=1
  1.  W ?45,APCLVPOV,?56,$E(APCLNAR,1,23)
  1.  G POV
  1.  ;
  1.  ;set and print procedures
  1. PRC S APCLVPRC=$O(^AUPNVPRC("AD",APCLVDFN,APCLVPRC))
  1.  Q:APCLVPRC=""
  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 Q:APCLSTOP="^"  W !
  1.  I 'APCLFPV S APCLFPV=1
  1.  W ?45,APCLPRC,?56,$E(APCLNAR,1,23)
  1.  G PRC
  1.  ;
  1. FINAL ;
  1.  Q:APCLCL'="A"
  1.  D HEAD
  1.  W !!?39,"TOTAL PATIENTS:  ",APCLPGRD
  1.  W !!?41,"TOTAL VISITS:  ",APCLVGRA
  1.  Q
  1.  ;
  1. TOTALS ;print totals
  1.  I $Y>(IOSL-5) D PAGE
  1.  W !!?28,"TOTAL PATIENTS FOR CLINIC:  ",APCLPTOT
  1.  W !!?30,"TOTAL VISITS FOR CLINIC:  ",APCLVTOT
  1.  S APCLPGRD=APCLPGRD+APCLPTOT,APCLVGRA=APCLVGRA+APCLVTOT
  1.  Q:IOST'?1"C-".E
  1.  ;R !!,"Enter <return> to continue or '^' to stop",APCLSTOP:DTIME
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I $D(DIRUT) S APCLSTOP="^" Q
  1.  Q
  1.  ;
  1.  W:$D(IOF) @IOF,!?11,"*****Confidential Patient Data Covered by Privacy Act*****",!
  1.  S X=$P(^DIC(4,DUZ(2),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
  1.  I $G(APCLCLX)="" S X="No Clinic data to report" G HD1
  1.  I APCLCLX="E" S X="VISITS WITH NO ASSIGNED CLINIC CODE" G HD1
  1.  I APCLCLX]"" S X="CLINIC VISITS FOR "_$P(^DIC(40.7,APCLCLX,0),"^")_" ("_$P(^(0),"^",2)_")" W ?(80-$L(X)/2),X
  1. HD1 S Y=DT X ^DD("DD") W !,Y
  1.  W ?28,"for ",$E(APCLBD,4,5),"/",$E(APCLBD,6,7),"/",$E(APCLBD,2,3)
  1.  W " to ",$E(APCLED,4,5),"/",$E(APCLED,6,7),"/",$E(APCLED,2,3)
  1.  W !!,"NAME",?16,"HRCN",?22,"AGE",?27,"VISIT DATE",?41,"PRV",?46,"ICD",?56,"PROV NARRATIVE",!
  1.  Q
  1.  ;
  1. PAGE ;form feed to new 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