IBDFN3 ;ALB/CJM - ENCOUNTER FORM - (entry points for reports); 5/21/93
;;3.0;AUTOMATED INFO COLLECTION SYS;**20,25,45**;APR 24, 1997
RXPROF ;Outpatient Pharmacy Action Profile and Information Profile
;INPUTS:
;PSDAYS = number of days to print the medication profile for
;PSTYPE=1 for the Action Profile, =0 for the Information Profile
;PSONOPG=2 variable needed to indicate to Profiles to not close device
; and not to form feed
;PSOSITE= Division -- ien from file 40.8, not always same as in file 59
;DFN
;
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
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
Q:(+$G(DFN)=0)
S IBDFN=DFN
S X1=DT,X2=-PSDAYS D C^%DTC S (PSDATE,PSDAY)=X
S LINE=$TR($J(" ",IOM)," ","-")
;
; -- get site name, turn on barcoding, set to not close device
S PSOINST=$P($$SITE^VASITE,"^",3)
S PSOPAR=1,PSONOPG=2
I $G(IBCLINIC)]"" S PSOSITE=$P($G(^SC(IBCLINIC,0)),"^",15)
I $G(PSTYPE)=0 S PAGE=1 D DFN^PSOSD1 ; -- Informational Profile
I $G(PSTYPE)=1 S PAGE=1 D DFN^PSOSD1 ; -- Action Profile
W:$Y @IOF
;
S DFN=IBDFN
K VA,VAEL,VAPA
Q
;
DRUGS ;prints the medication profile of Outpatient Pharmacy
;doesn't seem to be needed, integration agreement not obtained to use this
;INPUTS:
;PLS=0 for long, 1 for short
;PSRT="D" to sort by date, "M" to sort by medication, "C" to sort by class
;DFN
;
;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
;
;S (FN,IBDFN,D0,DA)=DFN
;I '$D(^PS(55,IBDFN,"P")),'$D(^("ARC")) D ^PSODEM W !?20,"NO PHARMACY INFORMATION" G RXQ
;I '$O(^PS(55,IBDFN,"P",0)),$D(^PS(55,IBDFN,"ARC")) D ^PSODEM W !!,"PATIENT HAS ARCHIVED PRESCRIPTIONS",! G RXQ
;D P^PSOP
RXQ ;W @IOF
;S DFN=IBDFN
;K ^UTILITY($J)
Q
ROUTING ;entry point for printing a routing sheet for a single patient
;Sets IBPRINT=1 so that it will be known that this entry point was used
;inputs -
; DFN
; IBAPPT - the appointment
; IBCLINIC - pointer to the clinic
;protect variables that may be changed
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
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
;
;protect DFN
Q:(+$G(DFN)=0)
S IBDFN=DFN N DFN S DFN=IBDFN
;
;set the start date to the date of the appt
S SDPARMS("START")=IBAPPT\1
;keep the device open
S SDPARMS("DO NOT CLOSE")=1
;set DIV to the division of IBCLINIC
S DIV=$P($G(^SC(IBCLINIC,0)),"^",15)
D EN1^SDROUT1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFN3 2860 printed Nov 22, 2024@18:03:05 Page 2
IBDFN3 ;ALB/CJM - ENCOUNTER FORM - (entry points for reports); 5/21/93
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**20,25,45**;APR 24, 1997
RXPROF ;Outpatient Pharmacy Action Profile and Information Profile
+1 ;INPUTS:
+2 ;PSDAYS = number of days to print the medication profile for
+3 ;PSTYPE=1 for the Action Profile, =0 for the Information Profile
+4 ;PSONOPG=2 variable needed to indicate to Profiles to not close device
+5 ; and not to form feed
+6 ;PSOSITE= Division -- ien from file 40.8, not always same as in file 59
+7 ;DFN
+8 ;
+9 NEW 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
+10 NEW 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
+11 if (+$GET(DFN)=0)
QUIT
+12 SET IBDFN=DFN
+13 SET X1=DT
SET X2=-PSDAYS
DO C^%DTC
SET (PSDATE,PSDAY)=X
+14 SET LINE=$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+15 ;
+16 ; -- get site name, turn on barcoding, set to not close device
+17 SET PSOINST=$PIECE($$SITE^VASITE,"^",3)
+18 SET PSOPAR=1
SET PSONOPG=2
+19 IF $GET(IBCLINIC)]""
SET PSOSITE=$PIECE($GET(^SC(IBCLINIC,0)),"^",15)
+20 ; -- Informational Profile
IF $GET(PSTYPE)=0
SET PAGE=1
DO DFN^PSOSD1
+21 ; -- Action Profile
IF $GET(PSTYPE)=1
SET PAGE=1
DO DFN^PSOSD1
+22 if $Y
WRITE @IOF
+23 ;
+24 SET DFN=IBDFN
+25 KILL VA,VAEL,VAPA
+26 QUIT
+27 ;
DRUGS ;prints the medication profile of Outpatient Pharmacy
+1 ;doesn't seem to be needed, integration agreement not obtained to use this
+2 ;INPUTS:
+3 ;PLS=0 for long, 1 for short
+4 ;PSRT="D" to sort by date, "M" to sort by medication, "C" to sort by class
+5 ;DFN
+6 ;
+7 ;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
+8 ;
+9 ;S (FN,IBDFN,D0,DA)=DFN
+10 ;I '$D(^PS(55,IBDFN,"P")),'$D(^("ARC")) D ^PSODEM W !?20,"NO PHARMACY INFORMATION" G RXQ
+11 ;I '$O(^PS(55,IBDFN,"P",0)),$D(^PS(55,IBDFN,"ARC")) D ^PSODEM W !!,"PATIENT HAS ARCHIVED PRESCRIPTIONS",! G RXQ
+12 ;D P^PSOP
RXQ ;W @IOF
+1 ;S DFN=IBDFN
+2 ;K ^UTILITY($J)
+3 QUIT
ROUTING ;entry point for printing a routing sheet for a single patient
+1 ;Sets IBPRINT=1 so that it will be known that this entry point was used
+2 ;inputs -
+3 ; DFN
+4 ; IBAPPT - the appointment
+5 ; IBCLINIC - pointer to the clinic
+6 ;protect variables that may be changed
+7 NEW %,%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
+8 NEW 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
+9 ;
+10 ;protect DFN
+11 if (+$GET(DFN)=0)
QUIT
+12 SET IBDFN=DFN
NEW DFN
SET DFN=IBDFN
+13 ;
+14 ;set the start date to the date of the appt
+15 SET SDPARMS("START")=IBAPPT\1
+16 ;keep the device open
+17 SET SDPARMS("DO NOT CLOSE")=1
+18 ;set DIV to the division of IBCLINIC
+19 SET DIV=$PIECE($GET(^SC(IBCLINIC,0)),"^",15)
+20 DO EN1^SDROUT1
+21 QUIT
