| [613] | 1 | IBDFN3 ;ALB/CJM - ENCOUNTER FORM - (entry points for reports); 5/21/93
 | 
|---|
 | 2 |  ;;3.0;AUTOMATED INFO COLLECTION SYS;**20,25,45**;APR 24, 1997
 | 
|---|
 | 3 | RXPROF ;Outpatient Pharmacy Action Profile and Information Profile
 | 
|---|
 | 4 |  ;INPUTS:
 | 
|---|
 | 5 |  ;PSDAYS = number of days to print the medication profile for
 | 
|---|
 | 6 |  ;PSTYPE=1 for the Action Profile, =0 for the Information Profile
 | 
|---|
 | 7 |  ;PSONOPG=2 variable needed to indicate to Profiles to not close device
 | 
|---|
 | 8 |  ;     and not to form feed
 | 
|---|
 | 9 |  ;PSOSITE= Division -- ien from file 40.8, not always same as in file 59
 | 
|---|
 | 10 |  ;DFN
 | 
|---|
 | 11 |  ;
 | 
|---|
 | 12 |  N IBDFN,ADDR,ADDRFL,CLASS,CNDT,DRUG,HDFL,I,II,J,L,LINE,P,PAGE,PSDOB,PSIIX,PSNAME,PSOI,PSSN,PSIX,PGM,PRF,PSDATE,VAL,VAR,RX,RX0,RX2,ST,ST0,PSDAY,RF,RFS
 | 
|---|
 | 13 |  N PSOPRINT,X1,X2,ZTSK,X,Y,PSII,PSDT,LMI,PSCNT,PSDIS,RXCNTLN,ELN,FN,CNT,VAERR,LN,PCLASS,PSOIFSUP,PSOINST,PSOSITE,PSONOPG,DUOUT,DTOUT,DIRUT
 | 
|---|
 | 14 |  Q:(+$G(DFN)=0)
 | 
|---|
 | 15 |  S IBDFN=DFN
 | 
|---|
 | 16 |  S X1=DT,X2=-PSDAYS D C^%DTC S (PSDATE,PSDAY)=X
 | 
|---|
 | 17 |  S LINE=$TR($J(" ",IOM)," ","-")
 | 
|---|
 | 18 |  ;
 | 
|---|
 | 19 |  ; -- get site name, turn on barcoding, set to not close device
 | 
|---|
 | 20 |  S PSOINST=$P($$SITE^VASITE,"^",3)
 | 
|---|
 | 21 |  S PSOPAR=1,PSONOPG=2
 | 
|---|
 | 22 |  I $G(IBCLINIC)]"" S PSOSITE=$P($G(^SC(IBCLINIC,0)),"^",15)
 | 
|---|
 | 23 |  I $G(PSTYPE)=0 S PAGE=1 D DFN^PSOSD1 ; -- Informational Profile
 | 
|---|
 | 24 |  I $G(PSTYPE)=1 S PAGE=1 D DFN^PSOSD1 ; -- Action Profile
 | 
|---|
 | 25 |  W:$Y @IOF
 | 
|---|
 | 26 |  ;
 | 
|---|
 | 27 |  S DFN=IBDFN
 | 
|---|
 | 28 |  K VA,VAEL,VAPA
 | 
|---|
 | 29 |  Q
 | 
|---|
 | 30 |  ;
 | 
|---|
 | 31 | DRUGS ;prints the medication profile of Outpatient Pharmacy
 | 
|---|
 | 32 |  ;doesn't seem to be needed, integration agreement not obtained to use this
 | 
|---|
 | 33 |  ;INPUTS:
 | 
|---|
 | 34 |  ;PLS=0 for long, 1 for short
 | 
|---|
 | 35 |  ;PSRT="D" to sort by date, "M" to sort by medication, "C" to sort by class
 | 
|---|
 | 36 |  ;DFN
 | 
|---|
 | 37 |  ;
 | 
|---|
 | 38 |  ;N IBDFN,DRUG,ZII,PHYS,CT,AL,I1,REF,LMI,PI,FN,Y,I,J,RX,DRX,ST,RX0,RX2,DA,D0,DIC,DIPGM,II,K,ST0,TEMP,Z,LMI,RXD,RXF,PI,AL,D0,DIPGM,II,PSCNT,PSDIV,PSLC,PSDIS
 | 
|---|
 | 39 |  ;
 | 
|---|
 | 40 |  ;S (FN,IBDFN,D0,DA)=DFN
 | 
|---|
 | 41 |  ;I '$D(^PS(55,IBDFN,"P")),'$D(^("ARC")) D ^PSODEM W !?20,"NO PHARMACY INFORMATION" G RXQ
 | 
|---|
 | 42 |  ;I '$O(^PS(55,IBDFN,"P",0)),$D(^PS(55,IBDFN,"ARC")) D ^PSODEM W !!,"PATIENT HAS ARCHIVED PRESCRIPTIONS",! G RXQ
 | 
|---|
 | 43 |  ;D P^PSOP
 | 
|---|
 | 44 | RXQ ;W @IOF
 | 
|---|
 | 45 |  ;S DFN=IBDFN
 | 
|---|
 | 46 |  ;K ^UTILITY($J)
 | 
|---|
 | 47 |  Q
 | 
|---|
 | 48 | ROUTING ;entry point for printing a routing sheet for a single patient
 | 
|---|
 | 49 |  ;Sets IBPRINT=1 so that it will be known that this entry point was used
 | 
|---|
 | 50 |  ;inputs - 
 | 
|---|
 | 51 |  ;    DFN
 | 
|---|
 | 52 |  ;    IBAPPT - the appointment
 | 
|---|
 | 53 |  ;    IBCLINIC - pointer to the clinic
 | 
|---|
 | 54 |  ;protect variables that may be changed
 | 
|---|
 | 55 |  N %,%DT,%I,ADDR,ALL,APDATE,IBDFN,DGMT,DIC,DIV,G,GDATE,H,I,J,K,L,LL,M,NAME,NDATE,ORD,ORDER,P,POP,PRDATE
 | 
|---|
 | 56 |  N SC,SDA,SDATE,SDCNT,SDI,SDI1,SDIQ,SDM,SDREP,SDSP,SDSTART,SDVA,SDX,SDX1,SSN,SZ,TDO,X,X1,Y,ZIP,ZX,VAR,C,V,SDEF,A,SD,SCN,SDTD,SDSCCOND,SDPARMS
 | 
|---|
 | 57 |  ;
 | 
|---|
 | 58 |  ;protect DFN
 | 
|---|
 | 59 |  Q:(+$G(DFN)=0)
 | 
|---|
 | 60 |  S IBDFN=DFN N DFN S DFN=IBDFN
 | 
|---|
 | 61 |  ;
 | 
|---|
 | 62 |  ;set the start date to the date of the appt
 | 
|---|
 | 63 |  S SDPARMS("START")=IBAPPT\1
 | 
|---|
 | 64 |  ;keep the device open
 | 
|---|
 | 65 |  S SDPARMS("DO NOT CLOSE")=1
 | 
|---|
 | 66 |  ;set DIV to the division of IBCLINIC
 | 
|---|
 | 67 |  S DIV=$P($G(^SC(IBCLINIC,0)),"^",15)
 | 
|---|
 | 68 |  D EN1^SDROUT1
 | 
|---|
 | 69 |  Q
 | 
|---|