Routine: APCDEFP1

APCDEFP1 ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form ;

 ;;2.0;IHS PCC SUITE;;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.

WVSK ;EP-- write out v skin test

 W !,"Skin Tests",!

 S APCDTA=0 F  S APCDTA=$O(APCDSK(APCDTA)) Q:APCDTA=""  D

 . S APCDTRES=$P(APCDSK(APCDTA),U)

 . S APCDTREA=$P(APCDSK(APCDTA),U,2)

 . S APCDTDTR=$P(APCDSK(APCDTA),U,3)

 . W !?3,"Skin Test: ",APCDTA

 . W ?40,"Result: ",APCDTRES

 . W !?3,"Reading: ",APCDTREA

 . W ?40,"Date Read: ",APCDTDTR

 . I $P(APCDSK(APCDTA),U,4)]"" W !?3,"Test Reader: ",$P(APCDSK(APCDTA),U,4)

 . I $P(APCDSK(APCDTA),U,5)]""!($P(APCDSK(APCDTA),U,6)]"") D

 . . W !?3,"Injection Site: ",$P(APCDSK(APCDTA),U,5),?40,"Volume: ",$P(APCDSK(APCDTA),U,6)

 K APCDSK,APCDRES,APCDREA,APCDDTR,APCDTRES,APCDTA,APCDTREA,APCDTDTR

 W !,APCDLN

WVTRT ;EP-- write out v treatment

 W !,"Treatments",!

 S APCDTA=0 F  S APCDTA=$O(APCDTRT(APCDTA)) Q:APCDTA=""  D

 . S APCDTHM=$P(APCDTRT(APCDTA),U)

 . S APCDTPRV=$P(APCDTRT(APCDTA),U,2)

 . W !,"Treatment: ",APCDTA

 . W ?40,"How Many: ",APCDTHM

 . W ?57,"Provider: ",APCDTPRV

 K APCDTRT,APCDHM,APCDPRV,APCDTA,APCDTHM,APCDTPRV

 W !,APCDLN

WVCPT ;EP -- write out v cpt

 W !,"CPT codes:",!

 I $G(APCDVEM)]"" W !,"Evalulation and Management: ",APCDVEM

 S APCDTA=0 F  S APCDTA=$O(APCDCPT(APCDTA)) Q:APCDTA=""  D

 . W !?3,$P(APCDCPT(APCDTA),U),?10,"Units: ",$P(APCDCPT(APCDTA),U,2),?21,$S($P(APCDCPT(APCDTA),U,3)]"":"Modifier 1: "_$P(APCDCPT(APCDTA),U,3),1:""),?40,$S($P(APCDCPT(APCDTA),U,4)]"":"Modifier 2: "_$P(APCDCPT(APCDTA),U,4),1:"")

 K APCDCPT,APCDUNI,APCDMD1,APCDMD2

 W !,APCDLN

WVPED ;EP-- write out v patient education

 W !,"Patient Education",!

 S APCDTA=0 F  S APCDTA=$O(APCDPED(APCDTA)) Q:APCDTA=""  D

 . W !?3,"Topic: ",APCDTA

 . W ?45,"Level of Understanding: ",$P($G(APCDPED(APCDTA)),U)

 . W:$P($G(APCDPED(APCDTA)),U,5)]"" !?3,"Comment: ",$P(APCDPED(APCDTA),U,5)

 . W:$P($G(APCDPED(APCDTA)),U,8)]"" !?3,"Provider Narrative: ",$P(APCDPED(APCDTA),U,8)

 . I $P(APCDPED(APCDTA),U,6)]"" W !?3,"Goal Code: ",$P(APCDPED(APCDTA),U,6)

 . I $P(APCDPED(APCDTA),U,7)]"" W !?3,"Goal Comment: ",$P(APCDPED(APCDTA),U,7)

 . I $P(APCDPED(APCDTA),U,2)]""!($P(APCDPED(APCDTA),U,3)]"")!($P(APCDPED(APCDTA),U,4)]"") W !?3,"Ind/Group: ",$P(APCDPED(APCDTA),U,2),?40,"Length of Educ: ",$P(APCDPED(APCDTA),U,3),?65,"CPT: ",$P(APCDPED(APCDTA),U,4)

 . I $P(APCDPED(APCDTA),U,9)]"" W !?3,"Readiness to Learn: ",$P(APCDPED(APCDTA),U,9)

 . W !

 K APCDPED,APCDLOU,APCDTA

 W !,APCDLN

WVPT ;EP-- write out v physical therapy

 W !,"Physical Therapy",!

 S APCDTA=0 F  S APCDTA=$O(APCDPT(APCDTA)) Q:APCDTA=""  D

 . W !,"Therapy: ",APCDTA

 . W ?40,"Quantity: ",$G(APCDPT(APCDPT))

 K APCDPT,APCDQTY,APCDTA

 W !,APCDLN

WVACT ;EP-- write out v activity time

 W !,"Activity Time",!

 S APCDTA=0 F  S APCDTA=$O(APCDACT(APCDTA)) Q:APCDTA=""  D

 . W !,"Activity Time: ",APCDTA

 . W ?30,"Travel Minutes: ",$G(APCDACT(APCDTA))

 K APCDACT,APCDTT,APCDTA

 W !,APCDLN

WVDXP ;EP-- write out v diagnostic procedure result

 W !,"Diagnostic Procedure Result",!

 S APCDTA=0 F  S APCDTA=$O(APCDDXP(APCDTA)) Q:APCDTA=""  D

 . W !,"Type: ",APCDTA

 . W ?40,"Value: ",$G(APCDDXP(APCDTA))

 K APCDDXP,APCDV,APCDTA

 W !,APCDLN

WVRAD ;EP-- write out v radiology

 W !,"Radiology",!

 S APCDTA=0 F  S APCDTA=$O(APCDRAD(APCDTA)) Q:APCDTA=""  D

 . W !,"Radiology Procedure: ",APCDRAD

 . W ?60,$S($G(APCDABN):"Abnormal",1:"")

 K APCDRAD,APCDABN,APCDTA

 W !,APCDLN

WVHF ;EP-- write out v health factors

 W !,"Health Factors: ",!

 S APCDTA=0 F  S APCDTA=$O(APCDHF(APCDTA)) Q:APCDTA=""  D

 . W !,"Health Factor: ",APCDTA

 . W ?50,"Level/Severity: ",$G(APCDHF(APCDTA))

 K APCDHF,APCDLS,APCDTA

 W !,APCDLN

WVMIC ;EP-- write out v microbiology

 W !,"Microbiology",!

 S APCDTA=0 F  S APCDTA=$O(APCDMIC(APCDTA)) Q:APCDTA=""  D

 . W !,"Culture: ",APCDTA

 . W ?40,"Organism: ",$G(APCDMIC(APCDTA))

 K APCDMIC,APCDORG,APCDTA

 W !,APCDLN

WVBB ;EP-- write out v blood bank

 W !,"Blood Bank",!

 S APCDTA=0 F  S APCDTA=$O(APCDBB(APCDTA)) Q:APCDTA=""  D

 . S APCDTRES=$P(APCDBB(APCDTA),U)

 . S APCDTAB=$P(APCDBB(APCDTA),U,2)

 . W !,"Lab Test: ",APCDTA

 . W ?40,"Result: ",APCDTRES

 . W ?60,"Antibody: ",APCDTAB

 K APCDBB,APCDRES,APCDABN,APCDTRES,APCDTAB

 W !,APCDLN

WVPHN ;EP-- write out v public health nurse

 W !,"Public Health Nursing",!

 S APCDTA=0 F  S APCDTA=$O(APCDPHN(APCDTA)) Q:APCDTA=""  D

 . S APCDTRES=$P(APCDPHN(APCDTA),U)

 . S APCDTLOI=$P(APCDPHN(APCDTA),U,2)

 . S APCDTTOD=$P(APCDPHN(APCDTA),U,3)

 . S APCDTR1=$P(APCDPHN(APCDTA),U,4)

 . S APCDTR2=$P(APCDPHN(APCDTA),U,5)

 . S APCDTR3=$P(APCDPHN(APCDTA),U,6)

 . S APCDTR4=$P(APCDPHN(APCDTA),U,7)

 . W !,"Form ID: ",APCDTA

 . W ?20,"Result: ",APCDTRES

 . W ?45,"Level of Intervention: ",APCDLOI

 . W !,"Type of Decision: ",APCDTTOD

 . W !,"Pscho/Social,Environ: ",APCDTR1

 . W !,"Nursing DX: ",APCDTR2

 . W !,"Short Term Goals: ",APCDTR3

 . W !,"Long Term Goals: ",APCDTR4

 K APCDPHN,APCDRES,APCDLOI,APCDTOD,APCDTA,APCDTREC,APCDTLOI,APCDTTOD

 K APCDREC0,APCDREC1,APCDREC2,APCDREC3,APCDREC4,APCDTR1,APCDTR2,APCDTR3

 K APCDTR4

 W !,APCDLN

WVNT ;EP-- write out v narrative text

 W !,"Narrative Text",!

 S APCDTA=0 F  S APCDTA=$O(APCDNT(APCDTA)) Q:APCDTA=""  D

 . W !,"Text Type: ",APCDTA

 . S APCDTNT=0 F  S APCDTNT=$O(APCDNT(APCDTA,APCDTNT)) Q:'APCDTNT  D

 .. W !,$G(APCDNT(APCDTA,APCDTNT))

 K APCDTVDF,APCDREC0,APCDNT,APCDUDA,APCDTNT

 W !,APCDLN

WVIF ;EP -- write out v infant feeding

 Q:'$D(APCDINF)

 W !,"Infant Feeding Choice:  ",$G(APCDINF),!

APCDEFP1  ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form ;

 +1       ;;2.0;IHS PCC SUITE;;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       ;

WVSK      ;EP-- write out v skin test

 +1        WRITE !,"Skin Tests",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDSK(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                SET APCDTRES=$PIECE(APCDSK(APCDTA),U)

 +4                SET APCDTREA=$PIECE(APCDSK(APCDTA),U,2)

 +5                SET APCDTDTR=$PIECE(APCDSK(APCDTA),U,3)

 +6                WRITE !?3,"Skin Test: ",APCDTA

 +7                WRITE ?40,"Result: ",APCDTRES

 +8                WRITE !?3,"Reading: ",APCDTREA

 +9                WRITE ?40,"Date Read: ",APCDTDTR

 +10               IF $PIECE(APCDSK(APCDTA),U,4)]""

                       WRITE !?3,"Test Reader: ",$PIECE(APCDSK(APCDTA),U,4)

 +11               IF $PIECE(APCDSK(APCDTA),U,5)]""!($PIECE(APCDSK(APCDTA),U,6)]"")

                       Begin DoDot:2

 +12                       WRITE !?3,"Injection Site: ",$PIECE(APCDSK(APCDTA),U,5),?40,"Volume: ",$PIECE(APCDSK(APCDTA),U,6)

                       End DoDot:2

               End DoDot:1

 +13       KILL APCDSK,APCDRES,APCDREA,APCDDTR,APCDTRES,APCDTA,APCDTREA,APCDTDTR

 +14       WRITE !,APCDLN

 +15       QUIT

 +16      ;

WVTRT     ;EP-- write out v treatment

 +1        WRITE !,"Treatments",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDTRT(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                SET APCDTHM=$PIECE(APCDTRT(APCDTA),U)

 +4                SET APCDTPRV=$PIECE(APCDTRT(APCDTA),U,2)

 +5                WRITE !,"Treatment: ",APCDTA

 +6                WRITE ?40,"How Many: ",APCDTHM

 +7                WRITE ?57,"Provider: ",APCDTPRV

               End DoDot:1

 +8        KILL APCDTRT,APCDHM,APCDPRV,APCDTA,APCDTHM,APCDTPRV

 +9        WRITE !,APCDLN

 +10       QUIT

 +11      ;

WVCPT     ;EP -- write out v cpt

 +1        WRITE !,"CPT codes:",!

 +2        IF $GET(APCDVEM)]""

               WRITE !,"Evalulation and Management: ",APCDVEM

 +3        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDCPT(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +4               WRITE !?3,$PIECE(APCDCPT(APCDTA),U),?10,"Units: ",$PIECE(APCDCPT(APCDTA),U,2),?21,$SELECT($PIECE(APCDCPT(APCDTA),U,3)]"":"Modifier 1: "_$PIECE(APCDCPT(APCDTA),U,3),1:""),?40,$SELECT(...

                   ... $PIECE(APCDCPT(APCDTA),U,4)]"":"Modifier 2: "_$PIECE(APCDCPT(APCDTA),U,4),1:"")

               End DoDot:1

 +5        KILL APCDCPT,APCDUNI,APCDMD1,APCDMD2

 +6        WRITE !,APCDLN

 +7        QUIT

WVPED     ;EP-- write out v patient education

 +1        WRITE !,"Patient Education",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDPED(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !?3,"Topic: ",APCDTA

 +4                WRITE ?45,"Level of Understanding: ",$PIECE($GET(APCDPED(APCDTA)),U)

 +5                IF $PIECE($GET(APCDPED(APCDTA)),U,5)]""

                       WRITE !?3,"Comment: ",$PIECE(APCDPED(APCDTA),U,5)

 +6                IF $PIECE($GET(APCDPED(APCDTA)),U,8)]""

                       WRITE !?3,"Provider Narrative: ",$PIECE(APCDPED(APCDTA),U,8)

 +7                IF $PIECE(APCDPED(APCDTA),U,6)]""

                       WRITE !?3,"Goal Code: ",$PIECE(APCDPED(APCDTA),U,6)

 +8                IF $PIECE(APCDPED(APCDTA),U,7)]""

                       WRITE !?3,"Goal Comment: ",$PIECE(APCDPED(APCDTA),U,7)

 +9                IF $PIECE(APCDPED(APCDTA),U,2)]""!($PIECE(APCDPED(APCDTA),U,3)]"")!($PIECE(APCDPED(APCDTA),U,4)]"")

                       WRITE !?3,"Ind/Group: ",$PIECE(APCDPED(APCDTA),U,2),?40,"Length of Educ: ",$PIECE(APCDPED(APCDTA),U,3),?65,"CPT: ",$PIECE(APCDPED(APCDTA),U,4)

 +10               IF $PIECE(APCDPED(APCDTA),U,9)]""

                       WRITE !?3,"Readiness to Learn: ",$PIECE(APCDPED(APCDTA),U,9)

 +11               WRITE !

               End DoDot:1

 +12       KILL APCDPED,APCDLOU,APCDTA

 +13       WRITE !,APCDLN

 +14       QUIT

 +15      ;

WVPT      ;EP-- write out v physical therapy

 +1        WRITE !,"Physical Therapy",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDPT(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"Therapy: ",APCDTA

 +4                WRITE ?40,"Quantity: ",$GET(APCDPT(APCDPT))

               End DoDot:1

 +5        KILL APCDPT,APCDQTY,APCDTA

 +6        WRITE !,APCDLN

 +7        QUIT

 +8       ;

WVACT     ;EP-- write out v activity time

 +1        WRITE !,"Activity Time",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDACT(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"Activity Time: ",APCDTA

 +4                WRITE ?30,"Travel Minutes: ",$GET(APCDACT(APCDTA))

               End DoDot:1

 +5        KILL APCDACT,APCDTT,APCDTA

 +6        WRITE !,APCDLN

 +7        QUIT

 +8       ;

WVDXP     ;EP-- write out v diagnostic procedure result

 +1        WRITE !,"Diagnostic Procedure Result",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDDXP(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"Type: ",APCDTA

 +4                WRITE ?40,"Value: ",$GET(APCDDXP(APCDTA))

               End DoDot:1

 +5        KILL APCDDXP,APCDV,APCDTA

 +6        WRITE !,APCDLN

 +7        QUIT

 +8       ;

WVRAD     ;EP-- write out v radiology

 +1        WRITE !,"Radiology",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDRAD(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"Radiology Procedure: ",APCDRAD

 +4                WRITE ?60,$SELECT($GET(APCDABN):"Abnormal",1:"")

               End DoDot:1

 +5        KILL APCDRAD,APCDABN,APCDTA

 +6        WRITE !,APCDLN

 +7        QUIT

 +8       ;

WVHF      ;EP-- write out v health factors

 +1        WRITE !,"Health Factors: ",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDHF(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"Health Factor: ",APCDTA

 +4                WRITE ?50,"Level/Severity: ",$GET(APCDHF(APCDTA))

               End DoDot:1

 +5        KILL APCDHF,APCDLS,APCDTA

 +6        WRITE !,APCDLN

 +7        QUIT

 +8       ;

WVMIC     ;EP-- write out v microbiology

 +1        WRITE !,"Microbiology",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDMIC(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"Culture: ",APCDTA

 +4                WRITE ?40,"Organism: ",$GET(APCDMIC(APCDTA))

               End DoDot:1

 +5        KILL APCDMIC,APCDORG,APCDTA

 +6        WRITE !,APCDLN

 +7        QUIT

 +8       ;

WVBB      ;EP-- write out v blood bank

 +1        WRITE !,"Blood Bank",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDBB(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                SET APCDTRES=$PIECE(APCDBB(APCDTA),U)

 +4                SET APCDTAB=$PIECE(APCDBB(APCDTA),U,2)

 +5                WRITE !,"Lab Test: ",APCDTA

 +6                WRITE ?40,"Result: ",APCDTRES

 +7                WRITE ?60,"Antibody: ",APCDTAB

               End DoDot:1

 +8        KILL APCDBB,APCDRES,APCDABN,APCDTRES,APCDTAB

 +9        WRITE !,APCDLN

 +10       QUIT

 +11      ;

WVPHN     ;EP-- write out v public health nurse

 +1        WRITE !,"Public Health Nursing",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDPHN(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                SET APCDTRES=$PIECE(APCDPHN(APCDTA),U)

 +4                SET APCDTLOI=$PIECE(APCDPHN(APCDTA),U,2)

 +5                SET APCDTTOD=$PIECE(APCDPHN(APCDTA),U,3)

 +6                SET APCDTR1=$PIECE(APCDPHN(APCDTA),U,4)

 +7                SET APCDTR2=$PIECE(APCDPHN(APCDTA),U,5)

 +8                SET APCDTR3=$PIECE(APCDPHN(APCDTA),U,6)

 +9                SET APCDTR4=$PIECE(APCDPHN(APCDTA),U,7)

 +10               WRITE !,"Form ID: ",APCDTA

 +11               WRITE ?20,"Result: ",APCDTRES

 +12               WRITE ?45,"Level of Intervention: ",APCDLOI

 +13               WRITE !,"Type of Decision: ",APCDTTOD

 +14               WRITE !,"Pscho/Social,Environ: ",APCDTR1

 +15               WRITE !,"Nursing DX: ",APCDTR2

 +16               WRITE !,"Short Term Goals: ",APCDTR3

 +17               WRITE !,"Long Term Goals: ",APCDTR4

               End DoDot:1

 +18       KILL APCDPHN,APCDRES,APCDLOI,APCDTOD,APCDTA,APCDTREC,APCDTLOI,APCDTTOD

 +19       KILL APCDREC0,APCDREC1,APCDREC2,APCDREC3,APCDREC4,APCDTR1,APCDTR2,APCDTR3

 +20       KILL APCDTR4

 +21       WRITE !,APCDLN

 +22       QUIT

 +23      ;

WVNT      ;EP-- write out v narrative text

 +1        WRITE !,"Narrative Text",!

 +2        SET APCDTA=0

FOR

               SET APCDTA=$ORDER(APCDNT(APCDTA))

               IF APCDTA=""

                   QUIT

               Begin DoDot:1

 +3                WRITE !,"Text Type: ",APCDTA

 +4                SET APCDTNT=0

FOR

                       SET APCDTNT=$ORDER(APCDNT(APCDTA,APCDTNT))

                       IF 'APCDTNT

                           QUIT

                       Begin DoDot:2

 +5                        WRITE !,$GET(APCDNT(APCDTA,APCDTNT))

                       End DoDot:2

               End DoDot:1

 +6        KILL APCDTVDF,APCDREC0,APCDNT,APCDUDA,APCDTNT

 +7        WRITE !,APCDLN

 +8        QUIT

 +9       ;

WVIF      ;EP -- write out v infant feeding

 +1        IF '$DATA(APCDINF)

               QUIT

 +2        WRITE !,"Infant Feeding Choice:  ",$GET(APCDINF),!

 +3        QUIT

APCDEFP1.m