Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDEFP

APCDEFP.m

Go to the documentation of this file. 
  1. APCDEFP ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form ; 16 Oct 2012  6:19 PM
  1.  ;;2.0;IHS PCC SUITE;**4,11**;MAY 14, 2009;Build 58
  1.  ;
  1.  ;This routine will print out an automated PCC encounter form for
  1.  ;a particular visit.
  1.  ;
  1.  ;
  1. MAIN ;EP -- loop through temp and print out the data
  1.  S APCDIOSL=IOSL
  1.  S APCDLN="",$P(APCDLN,"-",79)="-"
  1.  S APCLSTAR="",$P(APCLSTAR,"*",79)="*"
  1.  S APCLUS="",$P(APCLUS,"_",79)="_"
  1.  S APCDFF="I $Y>(IOSL-5) D FF^APCDEFU Q:APCDQ"
  1.  D HEAD^APCDEFU
  1.  I '$D(^XTMP(APCDJ,APCDH,"APCDEF")) W !!,"No visit information" Q
  1.  D PRT
  1.  D FOOT^APCDEFU
  1.  D DONE^APCDEFU
  1.  Q
  1.  ;
  1. PRT ;-- loop through and write the data     
  1.  I APCDVCC]"" W !,"Chief Complaint: ",APCDVCC W !,APCDLN
  1.  I APCDVFLG]""!(APCDVDP]"") W !,"Flag: ",APCDVFLG,?40,"Disposition: ",APCDVDP W !,APCDLN
  1.  ;
  1.  S APCDPDA=0 F  S APCDPDA=$O(@APCDATMP@(APCDPDA)) Q:'APCDPDA!($G(APCDQ))  D
  1.  . S APCDPDFN=0 F  S APCDPDFN=$O(@APCDATMP@(APCDPDA,APCDPDFN)) Q:APCDPDFN=""!($G(APCDQ))  D
  1.  .. S APCDP="W"_APCDPDFN
  1.  .. Q:$T(@APCDP)=""
  1.  .. D @APCDP
  1.  .. Q:$G(APCDQ)
  1.  Q
  1.  ;
  1. WVMSR ;-- write out v measurement
  1.  X APCDFF
  1.  S APCDPC=3,APCDC=0
  1.  W !,"Measurements",!
  1.  S APCDIEN="" F  S APCDIEN=$O(APCDMSR(APCDIEN)) Q:APCDIEN=""  D
  1.  . S APCDTA=$P(APCDMSR(APCDIEN),U,1)
  1.  . I APCDTA="AUD" W !?3,APCDTA_":"_$P($G(APCDMSR(APCDIEN)),U,2) S APCDPC=3,APCDC=0 Q
  1.  . S APCDC=APCDC+1
  1.  . I APCDC=1 W !
  1.  . W ?APCDPC,APCDTA_": "_$S($L(APCDTA)=2:" ",1:"")_$P($G(APCDMSR(APCDIEN)),U,2) S J=$P(APCDMSR(APCDIEN),U,3) F I=1:1 S P=$P(J,"|",I) Q:P=""  W "  ",P
  1.  . S APCDPC=APCDPC+40
  1.  . I APCDC=2 S APCDC=0,APCDPC=3
  1.  K APCDMSR,APCDT,APCDV,APCDPC
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVXAM ;-- write out v exam
  1.  X APCDFF
  1.  W !,"Examinations",!
  1.  S APCDTA=0 F  S APCDTA=$O(APCDXAM(APCDTA)) Q:APCDTA=""  D
  1.  . W !?3,APCDTA
  1.  . I APCDXAM(APCDTA)]"" W ?35,"result: ",APCDXAM(APCDTA)
  1.  K APCDXAM,APCDT,APCDV
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVPOV ;-- write out v pov
  1.  X APCDFF
  1.  W !,"Purpose of Visit",!
  1.  S APCDTA=0 F  S APCDTA=$O(APCDPOV(APCDTA)) Q:APCDTA=""  D
  1.  . W !?3,$P(APCDPOV(APCDTA),U,2),?60,$P($G(APCDPOV(APCDTA)),U,1)
  1.  . I $P(APCDPOV(APCDTA),U,3)]"" W !?5,"Stage: ",$P(APCDPOV(APCDTA),U,3)
  1.  . I $P(APCDPOV(APCDTA),U,4)]""!($P(APCDPOV(APCDTA),U,5)]"") W !?5,"Modifier: ",$P(APCDPOV(APCDTA),U,4),?45,"Cause of DX: ",$P(APCDPOV(APCDTA),U,5)
  1.  . I $P(APCDPOV(APCDTA),U,6)]""!($P(APCDPOV(APCDTA),U,9)]"")!($P(APCDPOV(APCDTA),U,10)]"") W !?5,"E Code: ",$P(APCDPOV(APCDTA),U,6),?30,"Cause: ",$P(APCDPOV(APCDTA),U,9),?60,"Cause: ",$P(APCDPOV(APCDTA),U,10)
  1.  . I $P(APCDPOV(APCDTA),U,11)]""!($P(APCDPOV(APCDTA),U,8)]"") W !?5,"Place of Occurrence: ",$P(APCDPOV(APCDTA),U,11),?45,"Date of Injury: ",$P(APCDPOV(APCDTA),U,8)
  1.  K APCDPOV,APCDTA
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVMED ;-- write out vmed
  1.  X APCDFF
  1.  W !,"Medications Prescribed",?30,"Sig",?68,"Qty",?76,"Days",!
  1.  S APCDTA=0 F  S APCDTA=$O(APCDMED(APCDTA)) Q:APCDTA=""  D
  1.  . S APCDTSIG=$P(APCDMED(APCDTA),U)
  1.  . S APCDTQTY=$P(APCDMED(APCDTA),U,2)
  1.  . S APCDTDP=$P(APCDMED(APCDTA),U,3)
  1.  . W !,$E(APCDTA,1,28),?30,$E(APCDTSIG,1,35),?68,APCDTQTY,?76,APCDTDP
  1.  K APCDMED,APCDSIG,APCDQTY,APCDDP,APCDTA,APCDTSIG,APCDTQTY,APCDTDP
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVEYE ;-- write out v eye
  1.  X APCDFF
  1.  W !,"Eye Glass",!
  1.  W !,"Reading Only: ",APCDRO
  1.  W ?22,"DRE Sphere: ",APCDRES
  1.  W ?43,"DRE Cylinder: ",APCDREC
  1.  W ?58,"DRE Axis: ",APCDREA
  1.  W !,"DLE Sphere: ",APCDLES
  1.  W ?22,"DLE Cylinder: ",APCDLEC
  1.  W ?43,"DLE Axis: ",APCDLEA
  1.  W ?58,"Reading Add R: ",APCDRAR
  1.  W !,"Reading Add L: ",APCDRAL
  1.  W ?22,"Eye Size: ",APCDES
  1.  W ?43,"Bridge: ",APCDBR
  1.  W ?58,"Temple: ",APCDTM
  1.  W !,"Pupil Distance Near: ",APCDPDN
  1.  W ?30,"Pupil Distance Far: ",APCDPDF
  1.  K APCDRO,APCDRES,APCDREC,APCDREA,APCDLES,APCDLEC,APCDLEA,APCDRAR
  1.  K APCDRAL,APCDES,APCDBR,APCDTM,APCDPDN,APCDPDF
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVDEN ;-- write out v dental
  1.  X APCDFF
  1.  W !,"Dental",!
  1.  S APCDTA=0 F  S APCDTA=$O(APCDDEN(APCDTA)) Q:APCDTA=""  D
  1.  . S APCDTNOU=$P(APCDDEN(APCDTA),U)
  1.  . S APCDTOS=$P(APCDDEN(APCDTA),U,2)
  1.  . S APCDTDTS=$P(APCDDEN(APCDTA),U,3)
  1.  . W !,"Ada Code: ",APCDTA
  1.  . W ?20,"Number of Units: ",APCDTNOU
  1.  . I APCDTOS]"" W !,"Operative Site: ",APCDTOS
  1.  . I APCDTDTS]"" W ?55,"Tooth Surface: ",APCDTDTS
  1.  K APCDADA,APCDNOU,APCDOS,APCDTS,APCDTA,APCDTNOU,APCDTOS,APCDTDTS
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVPRC ;-- write out v procedure
  1.  X APCDFF
  1.  W !,"Procedures",!
  1.  S APCDTA=0 F  S APCDTA=$O(APCDPRC(APCDTA)) Q:APCDTA=""  D
  1.  . S APCDTPRN=$P(APCDPRC(APCDTA),U)
  1.  . S APCDTPDT=$P(APCDPRC(APCDTA),U,2)
  1.  . W !,"Procedure: ",APCDTA
  1.  . W ?51,"Procedure Date: ",APCDTPDT
  1.  . W !,"Provider Narrative: ",APCDTPRN
  1.  K APCDPRC,APCDPRN,APCDPDT,APCDTA,APCDTPRN,APCDTPDT
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVLAB ;-- write out v lab
  1.  X APCDFF
  1.  W !,"Laboratory Tests",!
  1.  S APCDTA=0 F  S APCDTA=$O(APCDLAB(APCDTA)) Q:APCDTA=""  D
  1.  . S APCDTRES=$P(APCDLAB(APCDTA),U)
  1.  . S APCDTABN=$P(APCDLAB(APCDTA),U,2)
  1.  . W !,"Lab Test: ",APCDTA
  1.  . W ?50,"Result: ",APCDTRES
  1.  . W ?70,$S($G(APCDTABN):"Abnormal",1:"")
  1.  K APCDLAB,APCDRES,APCDABN,APCDTA,APCDTRES,APCDTABN
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVIMM ;-- write out v immunization
  1.  X APCDFF
  1.  W !,"Immunizations",!
  1.  S APCDTA=0 F  S APCDTA=$O(APCDIMM(APCDTA)) Q:APCDTA=""  D
  1.  . S APCDTSER=$P(APCDIMM(APCDTA),U)
  1.  . S APCDTLOT=$P(APCDIMM(APCDTA),U,2)
  1.  . S APCDTREA=$P(APCDIMM(APCDTA),U,3)
  1.  . S APCDDOSE=$P(APCDIMM(APCDTA),U,4)
  1.  . S APCDINJ=$P(APCDIMM(APCDTA),U,5)
  1.  . S APCDVOL=$P(APCDIMM(APCDTA),U,6)
  1.  . S APCDVDAT=$P(APCDIMM(APCDTA),U,7)
  1.  . W !?3,"Immunization: ",APCDTA
  1.  . W ?60,"Series: ",APCDTSER
  1.  . I APCDTLOT]""!(APCDTREA]"") W !?3,"Lot: ",APCDTLOT,?30,"Reaction: ",APCDTREA
  1.  . I APCDDOSE]""!(APCDINJ]"") D
  1.  . . W !?3,"Dose Override: ",APCDDOSE,?40,"Injection Site: ",APCDINJ
  1.  . I APCDVOL]""!(APCDVDAT]"") D
  1.  . . W !?3,"Volume: ",APCDVOL I APCDVDAT]"" W ?20,"Date of Vaccine Information Statement: ",APCDVDAT
  1.  K APCDIMM,APCDSER,APCDLOT,APCDREA,APCDTSER,APCDTA,APCDTLOT,APCDTREA,APCDVDAT,APCDVOL,APCDDOSE,APCDINJ
  1.  W !,APCDLN
  1.  Q
  1.  ;
  1. WVSK ;-- write out v skin test
  1.  X APCDFF
  1.  D WVSK^APCDEFP1
  1.  Q
  1.  ;
  1. WVTRT ;-- write out v treatment
  1.  X APCDFF
  1.  D WVTRT^APCDEFP1
  1.  Q
  1.  ;
  1. WVPED ;-- write out v patient education
  1.  X APCDFF
  1.  D WVPED^APCDEFP1
  1.  Q
  1.  ;
  1. WVPT ;-- write out v physical therapy
  1.  X APCDFF
  1.  D WVPT^APCDEFP1
  1.  Q
  1.  ;
  1. WVACT ;-- write out v activity time
  1.  X APCDFF
  1.  D WVACT^APCDEFP1
  1.  Q
  1.  ;
  1. WVDXP ;-- write out v diagnostic procedure result
  1.  X APCDFF
  1.  D WVDXP^APCDEFP1
  1.  Q
  1.  ;
  1. WVRAD ;-- write out v radiology
  1.  X APCDFF
  1.  D WVRAD^APCDEFP1
  1.  Q
  1.  ;
  1. WVHF ;-- write out v health factors
  1.  X APCDFF
  1.  D WVHF^APCDEFP1
  1.  Q
  1.  ;
  1. WVMIC ;-- write out v microbiology
  1.  X APCDFF
  1.  D WVMIC^APCDEFP1
  1.  Q
  1.  ;
  1. WVBB ;-- write out v blood bank
  1.  X APCDFF
  1.  D WVBB^APCDEFP1
  1.  Q
  1.  ;
  1. WVPHN ;-- write out v public health nurse
  1.  X APCDFF
  1.  D WVPHN^APCDEFP1
  1.  Q
  1.  ;
  1. WVNT ;-- write out v narrative text
  1.  X APCDFF
  1.  D WVNT^APCDEFP1
  1.  Q
  1.  ;
  1. WVCPT ;-- write out v cpt
  1.  X APCDFF
  1.  D WVCPT^APCDEFP1
  1.  Q
  1.  ;
  1. WVIF ;-- write out infant feeding
  1.  X APCDFF
  1.  D WVIF^APCDEFP1
  1.  Q