APCDEF ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Sort ;
;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
;
;This routine will print out an automated PCC encounter form for
;a particular visit. The visit IEN needs to be passed in for it
;to run. This will typically be called after data entry.
;
;
ASK ;-- ask the visit and either call this routine or visit display
D XIT
D GETPAT^APCDDISP
I APCDPAT="" W !,"No Patient Selected!" D XIT Q
D GETVISIT^APCDDISP
I APCDVSIT="" W !,"No Visit Selected!" D XIT Q
S DIR(0)="SB^D:Display Mode;F:Form Mode"
S DIR("A")="Would you like to see the visit in Display or Form Mode: "
S DIR("B")="F"
D ^DIR
G XIT:$D(DIRUT)
S APCDFD=Y
K DIR,Y
I APCDFD="D" D ^APCDVD,EOJ^APCDDISP Q
D EN(APCDVSIT)
Q
;
EN(APCDVIEN) ;-- this is the entry point from external packages
I '$G(APCDVIEN) W !,"No Visit Selected for PCC Encounter Form Print" Q
D VST,VFL,ZIS
Q
;
VST ;EP -- get the visit information
S APCDVREC=$G(^AUPNVSIT(APCDVIEN,0))
S APCDPAT=$$VAL^XBDIQ1(9000010,APCDVIEN,.05)
S APCDVDT=$$FMTE^XLFDT($$VALI^XBDIQ1(9000010,APCDVIEN,.01))
S APCDVCLN=$S($P(APCDVREC,U,8)'="":$$VAL^XBDIQ1(9000010,APCDVIEN,.08),1:"Not Specified")
S APCDVLOC=$$VAL^XBDIQ1(9000010,APCDVIEN,.06)
S APCDVEM=$$VAL^XBDIQ1(9000010,APCDVIEN,.17)
S APCDVSC=$$VAL^XBDIQ1(9000010,APCDVIEN,.07)
S APCDVHL=$$VAL^XBDIQ1(9000010,APCDVIEN,.22)
S APCDVDP=$$VAL^XBDIQ1(9000010,APCDVIEN,.33)
S APCDVCC=$$VAL^XBDIQ1(9000010,APCDVIEN,1401)
S APCDVFLG=$$VAL^XBDIQ1(9000010,APCDVIEN,1601)
Q
;
VFL ;EP -- let's loop through the v files and get the info
NEW DA,D0,DIC,DIQ,DR,DI
S APCDJ=$J,APCDH=$H
S APCDTMP="^XTMP(APCDJ,APCDH,""APCDEF"",APCDCTR,APCDVFA)"
S APCDCNT=1
S APCDVFLE=9000010 F S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99 D
. S APCDCTR=""
. I APCDVFLE=9000010.01 S APCDCTR=1
. I APCDVFLE=9000010.13 S APCDCTR=2
. I APCDVFLE=9000010.07 S APCDCTR=3
. I APCDVFLE=9000010.14 S APCDCTR=4
. I APCDCTR="" S APCDCTR=$P(APCDVFLE,".",2)+10000
. S APCDVNM=$P(^DIC(APCDVFLE,0),U)
. S APCDVDG=^DIC(APCDVFLE,0,"GL")
. S APCDVDGA=$P(APCDVDG,"(")
. S APCDVFA=$E(APCDVDGA,6,9)
. S APCDVIGR=APCDVDG_"""AD"",APCDVIEN,APCDVDFN)"
. S APCDVDFN=""
. F APCDVI=1:1 S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN="" D
.. I APCDVFLE=9000010.01 Q:$P($G(^AUPNVMSR(APCDVDFN,2)),U,1) ;skip measurements entered in error
.. I APCDVFLE=9000010.04 D Q
... K @APCDTMP@(APCDCNT)
... S @APCDTMP@(APCDCNT)=$G(@APCDVDGA@(APCDVDFN,19))
... S APCDCNT=APCDCNT+1
.. I APCDVFLE=9000010.13!(APCDVFLE=9000010.07)!(APCDVFLE=9000010.16)!(APCDVFLE=9000010.01) D Q
... S @APCDTMP@(APCDCNT)=APCDVDFN
... S APCDCNT=APCDCNT+1
.. I APCDVFLE=9000010.32 D Q
... S @APCDTMP@(APCDCNT)=APCDVDFN
... S APCDCNT=APCDCNT+1
.. I APCDVFLE=9000010.34 D Q
... S @APCDTMP@(APCDCNT)=APCDVDFN
... S APCDCNT=APCDCNT+1
.. S @APCDTMP@(APCDCNT)=$G(@APCDVDGA@(APCDVDFN,0))
.. S APCDCNT=APCDCNT+1
Q
;
ZIS ;-- device call
S XBRC="^APCDEFC",XBRP="^APCDEFP",XBNS="APCD",XBRX="XIT^APCDEF"
D ^XBDBQUE
;
XIT ;-- kill the variables and quit
D EN^XBVK("APCD")
Q
;
APCDEF ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Sort ;
+1 ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
+2 ;
+3 ;This routine will print out an automated PCC encounter form for
+4 ;a particular visit. The visit IEN needs to be passed in for it
+5 ;to run. This will typically be called after data entry.
+6 ;
+7 ;
ASK ;-- ask the visit and either call this routine or visit display
+1 DO XIT
+2 DO GETPAT^APCDDISP
+3 IF APCDPAT=""
WRITE !,"No Patient Selected!"
DO XIT
QUIT
+4 DO GETVISIT^APCDDISP
+5 IF APCDVSIT=""
WRITE !,"No Visit Selected!"
DO XIT
QUIT
+6 SET DIR(0)="SB^D:Display Mode;F:Form Mode"
+7 SET DIR("A")="Would you like to see the visit in Display or Form Mode: "
+8 SET DIR("B")="F"
+9 DO ^DIR
+10 IF $DATA(DIRUT)
GOTO XIT
+11 SET APCDFD=Y
+12 KILL DIR,Y
+13 IF APCDFD="D"
DO ^APCDVD
DO EOJ^APCDDISP
QUIT
+14 DO EN(APCDVSIT)
+15 QUIT
+16 ;
EN(APCDVIEN) ;-- this is the entry point from external packages
+1 IF '$GET(APCDVIEN)
WRITE !,"No Visit Selected for PCC Encounter Form Print"
QUIT
+2 DO VST
DO VFL
DO ZIS
+3 QUIT
+4 ;
VST ;EP -- get the visit information
+1 SET APCDVREC=$GET(^AUPNVSIT(APCDVIEN,0))
+2 SET APCDPAT=$$VAL^XBDIQ1(9000010,APCDVIEN,.05)
+3 SET APCDVDT=$$FMTE^XLFDT($$VALI^XBDIQ1(9000010,APCDVIEN,.01))
+4 SET APCDVCLN=$SELECT($PIECE(APCDVREC,U,8)'="":$$VAL^XBDIQ1(9000010,APCDVIEN,.08),1:"Not Specified")
+5 SET APCDVLOC=$$VAL^XBDIQ1(9000010,APCDVIEN,.06)
+6 SET APCDVEM=$$VAL^XBDIQ1(9000010,APCDVIEN,.17)
+7 SET APCDVSC=$$VAL^XBDIQ1(9000010,APCDVIEN,.07)
+8 SET APCDVHL=$$VAL^XBDIQ1(9000010,APCDVIEN,.22)
+9 SET APCDVDP=$$VAL^XBDIQ1(9000010,APCDVIEN,.33)
+10 SET APCDVCC=$$VAL^XBDIQ1(9000010,APCDVIEN,1401)
+11 SET APCDVFLG=$$VAL^XBDIQ1(9000010,APCDVIEN,1601)
+12 QUIT
+13 ;
VFL ;EP -- let's loop through the v files and get the info
+1 NEW DA,D0,DIC,DIQ,DR,DI
+2 SET APCDJ=$JOB
SET APCDH=$HOROLOG
+3 SET APCDTMP="^XTMP(APCDJ,APCDH,""APCDEF"",APCDCTR,APCDVFA)"
+4 SET APCDCNT=1
+5 SET APCDVFLE=9000010
FOR
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99
QUIT
Begin DoDot:1
+6 SET APCDCTR=""
+7 IF APCDVFLE=9000010.01
SET APCDCTR=1
+8 IF APCDVFLE=9000010.13
SET APCDCTR=2
+9 IF APCDVFLE=9000010.07
SET APCDCTR=3
+10 IF APCDVFLE=9000010.14
SET APCDCTR=4
+11 IF APCDCTR=""
SET APCDCTR=$PIECE(APCDVFLE,".",2)+10000
+12 SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)
+13 SET APCDVDG=^DIC(APCDVFLE,0,"GL")
+14 SET APCDVDGA=$PIECE(APCDVDG,"(")
+15 SET APCDVFA=$EXTRACT(APCDVDGA,6,9)
+16 SET APCDVIGR=APCDVDG_"""AD"",APCDVIEN,APCDVDFN)"
+17 SET APCDVDFN=""
+18 FOR APCDVI=1:1
SET APCDVDFN=$ORDER(@APCDVIGR)
IF APCDVDFN=""
QUIT
Begin DoDot:2
+19 ;skip measurements entered in error
IF APCDVFLE=9000010.01
IF $PIECE($GET(^AUPNVMSR(APCDVDFN,2)),U,1)
QUIT
+20 IF APCDVFLE=9000010.04
Begin DoDot:3
+21 KILL @APCDTMP@(APCDCNT)
+22 SET @APCDTMP@(APCDCNT)=$GET(@APCDVDGA@(APCDVDFN,19))
+23 SET APCDCNT=APCDCNT+1
End DoDot:3
QUIT
+24 IF APCDVFLE=9000010.13!(APCDVFLE=9000010.07)!(APCDVFLE=9000010.16)!(APCDVFLE=9000010.01)
Begin DoDot:3
+25 SET @APCDTMP@(APCDCNT)=APCDVDFN
+26 SET APCDCNT=APCDCNT+1
End DoDot:3
QUIT
+27 IF APCDVFLE=9000010.32
Begin DoDot:3
+28 SET @APCDTMP@(APCDCNT)=APCDVDFN
+29 SET APCDCNT=APCDCNT+1
End DoDot:3
QUIT
+30 IF APCDVFLE=9000010.34
Begin DoDot:3
+31 SET @APCDTMP@(APCDCNT)=APCDVDFN
+32 SET APCDCNT=APCDCNT+1
End DoDot:3
QUIT
+33 SET @APCDTMP@(APCDCNT)=$GET(@APCDVDGA@(APCDVDFN,0))
+34 SET APCDCNT=APCDCNT+1
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
ZIS ;-- device call
+1 SET XBRC="^APCDEFC"
SET XBRP="^APCDEFP"
SET XBNS="APCD"
SET XBRX="XIT^APCDEF"
+2 DO ^XBDBQUE
+3 ;
XIT ;-- kill the variables and quit
+1 DO EN^XBVK("APCD")
+2 QUIT
+3 ;
