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
Q
;
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
Q
;
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
Q
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
WVIF ;EP -- write out v infant feeding
Q:'$D(APCDINF)
W !,"Infant Feeding Choice: ",$G(APCDINF),!
Q
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
