APCDEF.m

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       ;