APCLNJ11.m

APCLNJ11 ; IHS/CMI/LAB - PRINT CLINIC VISITS (CALC) ;

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 ;

CALC ;find visits by date then store by patient name

 D XTMP^APCLOSUT("APCLNJ1","PCC INJURY REPORT 1")

 ;

 S APCLJOB=$J,APCLBT=$H

 S APCLVDT=APCLBD-.0001

VST S APCLVDT=$O(^AUPNVSIT("B",APCLVDT))

 G NEXT:APCLVDT="",NEXT:APCLVDT>(APCLED+.2359) S APCLVDFN=0

VST1 S APCLVDFN=$O(^AUPNVSIT("B",APCLVDT,APCLVDFN)) G VST:APCLVDFN=""

 ;

 G VST1:'$D(^AUPNVSIT(APCLVDFN,0)) S APCLSTR=^(0)

 G VST1:$P(APCLSTR,"^",11) ;screen out deleted visits

 G VST1:$P(APCLSTR,"^",6)=""  ;no location

 G VST1:$P(APCLSTR,"^",7)=""

 G VST1:$$DEMO^APCLUTL($P(APCLSTR,U,5),$G(APCLDEMO))

 I $D(APCLLOCT),'$D(APCLLOCT($P(APCLSTR,U,6))) G VST1

 I $D(APCLSCT),'$D(APCLSCT($P(APCLSTR,U,7))) G VST1

 I $D(APCLTYPT),'$D(APCLTYPT($P(APCLSTR,U,3))) G VST1

 I $D(APCLCLNT),$P(APCLSTR,U,8)="" G VST1

 I $D(APCLCLNT),'$D(APCLCLNT($P(APCLSTR,U,8))) G VST1

 I $D(APCLAGET),$$AGE^AUPNPAT($P(APCLSTR,U,5))>$P(APCLAGET,"-",2) G VST1

 I $D(APCLAGET),$$AGE^AUPNPAT($P(APCLSTR,U,5))<$P(APCLAGET,"-",1) G VST1

 ;

 S APCLDFN=$P(APCLSTR,"^",5) G:APCLDFN="" VST1 ;IHS/CMI/LAB

 G VST1:'$D(^DPT(APCLDFN,0))

 S APCLNAME=$P(^DPT(APCLDFN,0),"^")

 D POV

 G VST1

 ;

NEXT ;

 S APCLET=$H

 Q

 ;

POV ;check to see if pov is injury

 ;IHS/CMI/LAB - patched line below

 ;NEW X S X=0 F  S X=$O(^AUPNVPOV("AD",APCLVDFN,X)) Q:X'=+X  I $P(^ICD9(+^AUPNVPOV(X,0),0),U)>799.999 D  ;cmi/anch/maw 9/10/2007 orig line

 ;NEW X S X=0 F  S X=$O(^AUPNVPOV("AD",APCLVDFN,X)) Q:X'=+X  I $P($$ICDDX^ICDEX(+^AUPNVPOV(X,0)),U,2)>799.999 D  ;cmi/anch/maw 9/10/2007 csv

 NEW X S X=0 F  S X=$O(^AUPNVPOV("AD",APCLVDFN,X)) Q:X'=+X  I $$INJ^APCDAPOV($$CODEC^ICDEX(80,+^AUPNVPOV(X,0)),$$CSI^ICDEX(80,+^AUPNVPOV(X,0))) D

 .I $D(APCLALCH),APCLALCH="L",$P(^AUPNVPOV(X,0),U,7)'=2 Q

 .S ^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT,APCLVDFN,X)=""

 .Q

 Q

APCLNJ11  ; IHS/CMI/LAB - PRINT CLINIC VISITS (CALC) ;

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +2       ;

CALC      ;find visits by date then store by patient name

 +1        DO XTMP^APCLOSUT("APCLNJ1","PCC INJURY REPORT 1")

 +2       ;

 +3        SET APCLJOB=$JOB

           SET APCLBT=$HOROLOG

 +4        SET APCLVDT=APCLBD-.0001

VST        SET APCLVDT=$ORDER(^AUPNVSIT("B",APCLVDT))

 +1        IF APCLVDT=""

               GOTO NEXT

           IF APCLVDT>(APCLED+.2359)

               GOTO NEXT

           SET APCLVDFN=0

VST1       SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLVDT,APCLVDFN))

           IF APCLVDFN=""

               GOTO VST

 +1       ;

 +2        IF '$DATA(^AUPNVSIT(APCLVDFN,0))

               GOTO VST1

           SET APCLSTR=^(0)

 +3       ;screen out deleted visits

           IF $PIECE(APCLSTR,"^",11)

               GOTO VST1

 +4       ;no location

           IF $PIECE(APCLSTR,"^",6)=""

               GOTO VST1

 +5        IF $PIECE(APCLSTR,"^",7)=""

               GOTO VST1

 +6        IF $$DEMO^APCLUTL($PIECE(APCLSTR,U,5),$GET(APCLDEMO))

               GOTO VST1

 +7        IF $DATA(APCLLOCT)

               IF '$DATA(APCLLOCT($PIECE(APCLSTR,U,6)))

                   GOTO VST1

 +8        IF $DATA(APCLSCT)

               IF '$DATA(APCLSCT($PIECE(APCLSTR,U,7)))

                   GOTO VST1

 +9        IF $DATA(APCLTYPT)

               IF '$DATA(APCLTYPT($PIECE(APCLSTR,U,3)))

                   GOTO VST1

 +10       IF $DATA(APCLCLNT)

               IF $PIECE(APCLSTR,U,8)=""

                   GOTO VST1

 +11       IF $DATA(APCLCLNT)

               IF '$DATA(APCLCLNT($PIECE(APCLSTR,U,8)))

                   GOTO VST1

 +12       IF $DATA(APCLAGET)

               IF $$AGE^AUPNPAT($PIECE(APCLSTR,U,5))>$PIECE(APCLAGET,"-",2)

                   GOTO VST1

 +13       IF $DATA(APCLAGET)

               IF $$AGE^AUPNPAT($PIECE(APCLSTR,U,5))<$PIECE(APCLAGET,"-",1)

                   GOTO VST1

 +14      ;

 +15      ;IHS/CMI/LAB

           SET APCLDFN=$PIECE(APCLSTR,"^",5)

           IF APCLDFN=""

               GOTO VST1

 +16       IF '$DATA(^DPT(APCLDFN,0))

               GOTO VST1

 +17       SET APCLNAME=$PIECE(^DPT(APCLDFN,0),"^")

 +18       DO POV

 +19       GOTO VST1

 +20      ;

NEXT      ;

 +1        SET APCLET=$HOROLOG

 +2        QUIT 

 +3       ;

POV       ;check to see if pov is injury

 +1       ;IHS/CMI/LAB - patched line below

 +2       ;NEW X S X=0 F  S X=$O(^AUPNVPOV("AD",APCLVDFN,X)) Q:X'=+X  I $P(^ICD9(+^AUPNVPOV(X,0),0),U)>799.999 D  ;cmi/anch/maw 9/10/2007 orig line

 +3       ;NEW X S X=0 F  S X=$O(^AUPNVPOV("AD",APCLVDFN,X)) Q:X'=+X  I $P($$ICDDX^ICDEX(+^AUPNVPOV(X,0)),U,2)>799.999 D  ;cmi/anch/maw 9/10/2007 csv

 +4        NEW X

           SET X=0

           FOR 

               SET X=$ORDER(^AUPNVPOV("AD",APCLVDFN,X))

               IF X'=+X

                   QUIT 

               IF $$INJ^APCDAPOV($$CODEC^ICDEX(80,+^AUPNVPOV(X,0)),$$CSI^ICDEX(80,+^AUPNVPOV(X,0)))

                   Begin DoDot:1

 +5                    IF $DATA(APCLALCH)

                           IF APCLALCH="L"

                               IF $PIECE(^AUPNVPOV(X,0),U,7)'=2

                                   QUIT 

 +6                    SET ^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT,APCLVDFN,X)=""

 +7                    QUIT 

                   End DoDot:1

 +8        QUIT