PSOSPML5 ;BIRM/MFR - SPMP Information Disclosure Report ;04/10/13
;;7.0;OUTPATIENT PHARMACY;**408**;DEC 1997;Build 100
;
N %DT,BATIEN,DIR,DIRUT,X,Y,DIC,DTOUT,DUOUT,PSOFROM,PSOTO,PSOST,PSOPT
;
; - Ask for FROM DATE
S %DT(0)=-DT,%DT="AEP",%DT("A")=" BEGIN DATE: "
W ! D ^%DT I Y<0!($D(DTOUT)) G EXIT
S PSOFROM=Y\1-.00001
;
; - Ask for TO DATE
K %DT S %DT(0)=PSOFROM+1\1,%DT="AEP",%DT("B")="TODAY",%DT("A")=" END DATE: "
W ! D ^%DT I Y<0!($D(DTOUT)) G EXIT
S PSOTO=Y\1+.99999
;
; - Selection of STATE to print on the Report
N DIC,X,I,Y K PSOST S PSOST=""
W !!,?5,"You may select a single or multiple STATES,"
W !,?5,"or enter ^ALL to select all STATES.",!
S DIC("B")=$$GET1^DIQ(5,+$O(^PS(58.41,0)),.01)
S DIC=5,DIC(0)="QEAM",DIC("A")=" Select STATE: "
F D ^DIC Q:Y<0 S PSOST(+Y)="" K DIC("B") S DIC("A")=" Another STATE: "
I X="^ALL" S PSOST="ALL"
I $G(PSOST)'="ALL",$D(DUOUT)!($D(DTOUT)) Q
I $G(PSOST)'="ALL",'$O(PSOST(0)) Q
;
; - Selection of PATIENTS to print on the Report
N DIC,X,I,Y K PSOPT S PSOPT=""
W !!,?5,"You may select a single or multiple PATIENTS,"
W !,?5,"or enter ^ALL to select all PATIENTS.",!
S DIC(0)="QEAM",DIC("A")=" Select PATIENT: ",DIC("B")="^ALL"
F D EN^PSOPATLK S Y=PSOPTLK Q:+Y<1 S PSOPT(+Y)="" K PSOPTLK S DIC("A")=" Another PATIENT: "
I Y="^ALL" K PSOPT S PSOPT="ALL"
I $G(PSOPT)'="ALL",$G(PSOPTLK)="^" Q
I $G(PSOPT)'="ALL",'$O(PSOPT(0)) Q
;
W !!,"Please wait..."
;
D EN(PSOFROM,PSOTO,.PSOST,.PSOPT)
;
G EXIT
;
EN(PSOFROM,PSOTO,PSOST,PSOPT) ; Entry point
D EN^VALM("PSO SPMP DISCLOSURE REPORT")
D FULL^VALM1
Q
;
HDR ; - Builds the Header section
S VALMHDR(1)="Date Range: "_$$FMTE^XLFDT(PSOFROM+1\1,2)_" - "_$$FMTE^XLFDT(PSOTO\1,2)
S VALMHDR(2)="State(s): "_$S($G(PSOST)="ALL":"ALL",$O(PSOST($O(PSOST(0)))):"Multiple",1:$$GET1^DIQ(5,+$O(PSOST(0)),.01))
S $E(VALMHDR(2),40)="Patient(s): "_$S($G(PSOPT)="ALL":"ALL",$O(PSOPT($O(PSOPT(0)))):"Multiple",1:$$GET1^DIQ(2,+$O(PSOPT(0)),.01))
S VALMHDR(3)=""
S VALMHDR(4)=" # DT DISC PATIENT Rx# DRUG"
Q
;
INIT ; Builds the Body section
N RXCNT,BATDT,I,LINE,TYPE,NODE0,RX,COUNT,DRUGIEN,DRUGNAM,DRUGDEA,DSPLINE,FILL,RECTYPE,DFN,L4SSN
N BATRXIEN,DISCDT,PATNAM,PATIEN,RXIEN,RXNFLL,RXNUM,STATE
;
K ^TMP("PSOSPSRT",$J)
S BATDT=PSOFROM
F S BATDT=$O(^PS(58.42,"AD",BATDT)) Q:'BATDT!(BATDT>PSOTO) D
. S BATIEN=0 F S BATIEN=$O(^PS(58.42,"AD",BATDT,BATIEN)) Q:'BATIEN D
. . S STATE=$$GET1^DIQ(58.42,BATIEN,1,"I")
. . S DISCDT=$P(^PS(58.42,BATIEN,0),"^",10) I 'DISCDT Q
. . I $G(PSOST)'="ALL",'$D(PSOST(STATE)) Q
. . S BATRXIEN=0 F S BATRXIEN=$O(^PS(58.42,BATIEN,"RX",BATRXIEN)) Q:'BATRXIEN D
. . . S NODE0=$G(^PS(58.42,BATIEN,"RX",BATRXIEN,0))
. . . S RXIEN=+NODE0,FILL=$P(NODE0,"^",2),RECTYPE=$P(NODE0,"^",3),PATIEN=$$GET1^DIQ(52,RXIEN,2,"I")
. . . I $G(PSOPT)'="ALL",'$D(PSOPT(PATIEN)) Q
. . . S ^TMP("PSOSPSRT",$J,$$GET1^DIQ(5,STATE,.01),$$GET1^DIQ(52,RXIEN,2)_"^"_PATIEN,RXIEN_"^"_FILL_"^"_BATIEN)=DISCDT\1
;
K ^TMP("PSOSPML5",$J) S (VALMCNT,LINE,RXCNT,COUNT)=0
S (STATE,PATNAM,RXNFLL)="",COUNT=0
F S STATE=$O(^TMP("PSOSPSRT",$J,STATE)) Q:STATE="" D
. D SETLN^PSOSPMU1("PSOSPML5","Disclosed to:"_STATE,0,0,0)
. D SETLN^PSOSPMU1("PSOSPML5","Info Disclosed: Name, DOB, SSN, Prescription Data, Home Address, Phone Number",0,0,0)
. F S PATNAM=$O(^TMP("PSOSPSRT",$J,STATE,PATNAM)) Q:PATNAM="" D
. . S DFN=$P(PATNAM,"^",2) D DEM^VADPT S L4SSN=$P($P(VADM(2),"^",2),"-",3)
. . F S RXNFLL=$O(^TMP("PSOSPSRT",$J,STATE,PATNAM,RXNFLL)) Q:RXNFLL="" D
. . . S DISCDT=^TMP("PSOSPSRT",$J,STATE,PATNAM,RXNFLL)
. . . S RXIEN=+RXNFLL,FILL=$P(RXNFLL,"^",2),RECTYPE=$P(RXNFLL,"^",3)
. . . S RXNUM=$$GET1^DIQ(52,RXIEN,.01)
. . . S DRUGNAM=$$GET1^DIQ(52,RXIEN,6)
. . . S COUNT=COUNT+1
. . . S DSPLINE=$J(COUNT,4)_" "_$$FMTE^XLFDT(DISCDT,"2Y"),$E(DSPLINE,14)=$E($P(PATNAM,"^"),1,20)_"("_L4SSN_")"
. . . S $E(DSPLINE,41)=RXNUM,$E(DSPLINE,56)=$E(DRUGNAM,1,25)
. . . D SETLN^PSOSPMU1("PSOSPML5",DSPLINE,0,0,0)
. . . S ^TMP("PSOSPML5",$J,COUNT,"RX")=RXIEN_"^"_FILL_"^"_RECTYPE
. D SETLN^PSOSPMU1("PSOSPML5"," ",0,0,0)
I '$D(^TMP("PSOSPML5",$J)) D
. D SETLN^PSOSPMU1("PSOSPML5","No data found for the date range selected.",0,0,0)
S VALMCNT=LINE
Q
;
SEL ;Process selection of one entry
N PSOSEL,XQORM,ORD,TITLE,RXINFO,LINE
S PSOSEL=+$P(XQORNOD(0),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
S RXINFO=$G(^TMP("PSOSPML5",$J,PSOSEL,"RX"))
I 'RXINFO S VALMSG="Invalid selection!",VALMBCK="R" Q
S TITLE=VALM("TITLE")
D EN^PSOSPML4(+RXINFO,$P(RXINFO,"^",2),$P(RXINFO,"^",3))
S VALMBCK="R",VALM("TITLE")=TITLE
D INIT,HDR
Q
;
EXIT ;
K ^TMP("PSOSPML5",$J)
Q
;
HELP ; Listman HELP entry-point
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPML5 4823 printed Sep 23, 2025@20:11:32 Page 2
PSOSPML5 ;BIRM/MFR - SPMP Information Disclosure Report ;04/10/13
+1 ;;7.0;OUTPATIENT PHARMACY;**408**;DEC 1997;Build 100
+2 ;
+3 NEW %DT,BATIEN,DIR,DIRUT,X,Y,DIC,DTOUT,DUOUT,PSOFROM,PSOTO,PSOST,PSOPT
+4 ;
+5 ; - Ask for FROM DATE
+6 SET %DT(0)=-DT
SET %DT="AEP"
SET %DT("A")=" BEGIN DATE: "
+7 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
GOTO EXIT
+8 SET PSOFROM=Y\1-.00001
+9 ;
+10 ; - Ask for TO DATE
+11 KILL %DT
SET %DT(0)=PSOFROM+1\1
SET %DT="AEP"
SET %DT("B")="TODAY"
SET %DT("A")=" END DATE: "
+12 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
GOTO EXIT
+13 SET PSOTO=Y\1+.99999
+14 ;
+15 ; - Selection of STATE to print on the Report
+16 NEW DIC,X,I,Y
KILL PSOST
SET PSOST=""
+17 WRITE !!,?5,"You may select a single or multiple STATES,"
+18 WRITE !,?5,"or enter ^ALL to select all STATES.",!
+19 SET DIC("B")=$$GET1^DIQ(5,+$ORDER(^PS(58.41,0)),.01)
+20 SET DIC=5
SET DIC(0)="QEAM"
SET DIC("A")=" Select STATE: "
+21 FOR
DO ^DIC
if Y<0
QUIT
SET PSOST(+Y)=""
KILL DIC("B")
SET DIC("A")=" Another STATE: "
+22 IF X="^ALL"
SET PSOST="ALL"
+23 IF $GET(PSOST)'="ALL"
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+24 IF $GET(PSOST)'="ALL"
IF '$ORDER(PSOST(0))
QUIT
+25 ;
+26 ; - Selection of PATIENTS to print on the Report
+27 NEW DIC,X,I,Y
KILL PSOPT
SET PSOPT=""
+28 WRITE !!,?5,"You may select a single or multiple PATIENTS,"
+29 WRITE !,?5,"or enter ^ALL to select all PATIENTS.",!
+30 SET DIC(0)="QEAM"
SET DIC("A")=" Select PATIENT: "
SET DIC("B")="^ALL"
+31 FOR
DO EN^PSOPATLK
SET Y=PSOPTLK
if +Y<1
QUIT
SET PSOPT(+Y)=""
KILL PSOPTLK
SET DIC("A")=" Another PATIENT: "
+32 IF Y="^ALL"
KILL PSOPT
SET PSOPT="ALL"
+33 IF $GET(PSOPT)'="ALL"
IF $GET(PSOPTLK)="^"
QUIT
+34 IF $GET(PSOPT)'="ALL"
IF '$ORDER(PSOPT(0))
QUIT
+35 ;
+36 WRITE !!,"Please wait..."
+37 ;
+38 DO EN(PSOFROM,PSOTO,.PSOST,.PSOPT)
+39 ;
+40 GOTO EXIT
+41 ;
EN(PSOFROM,PSOTO,PSOST,PSOPT) ; Entry point
+1 DO EN^VALM("PSO SPMP DISCLOSURE REPORT")
+2 DO FULL^VALM1
+3 QUIT
+4 ;
HDR ; - Builds the Header section
+1 SET VALMHDR(1)="Date Range: "_$$FMTE^XLFDT(PSOFROM+1\1,2)_" - "_$$FMTE^XLFDT(PSOTO\1,2)
+2 SET VALMHDR(2)="State(s): "_$SELECT($GET(PSOST)="ALL":"ALL",$ORDER(PSOST($ORDER(PSOST(0)))):"Multiple",1:$$GET1^DIQ(5,+$ORDER(PSOST(0)),.01))
+3 SET $EXTRACT(VALMHDR(2),40)="Patient(s): "_$SELECT($GET(PSOPT)="ALL":"ALL",$ORDER(PSOPT($ORDER(PSOPT(0)))):"Multiple",1:$$GET1^DIQ(2,+$ORDER(PSOPT(0)),.01))
+4 SET VALMHDR(3)=""
+5 SET VALMHDR(4)=" # DT DISC PATIENT Rx# DRUG"
+6 QUIT
+7 ;
INIT ; Builds the Body section
+1 NEW RXCNT,BATDT,I,LINE,TYPE,NODE0,RX,COUNT,DRUGIEN,DRUGNAM,DRUGDEA,DSPLINE,FILL,RECTYPE,DFN,L4SSN
+2 NEW BATRXIEN,DISCDT,PATNAM,PATIEN,RXIEN,RXNFLL,RXNUM,STATE
+3 ;
+4 KILL ^TMP("PSOSPSRT",$JOB)
+5 SET BATDT=PSOFROM
+6 FOR
SET BATDT=$ORDER(^PS(58.42,"AD",BATDT))
if 'BATDT!(BATDT>PSOTO)
QUIT
Begin DoDot:1
+7 SET BATIEN=0
FOR
SET BATIEN=$ORDER(^PS(58.42,"AD",BATDT,BATIEN))
if 'BATIEN
QUIT
Begin DoDot:2
+8 SET STATE=$$GET1^DIQ(58.42,BATIEN,1,"I")
+9 SET DISCDT=$PIECE(^PS(58.42,BATIEN,0),"^",10)
IF 'DISCDT
QUIT
+10 IF $GET(PSOST)'="ALL"
IF '$DATA(PSOST(STATE))
QUIT
+11 SET BATRXIEN=0
FOR
SET BATRXIEN=$ORDER(^PS(58.42,BATIEN,"RX",BATRXIEN))
if 'BATRXIEN
QUIT
Begin DoDot:3
+12 SET NODE0=$GET(^PS(58.42,BATIEN,"RX",BATRXIEN,0))
+13 SET RXIEN=+NODE0
SET FILL=$PIECE(NODE0,"^",2)
SET RECTYPE=$PIECE(NODE0,"^",3)
SET PATIEN=$$GET1^DIQ(52,RXIEN,2,"I")
+14 IF $GET(PSOPT)'="ALL"
IF '$DATA(PSOPT(PATIEN))
QUIT
+15 SET ^TMP("PSOSPSRT",$JOB,$$GET1^DIQ(5,STATE,.01),$$GET1^DIQ(52,RXIEN,2)_"^"_PATIEN,RXIEN_"^"_FILL_"^"_BATIEN)=DISCDT\1
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 KILL ^TMP("PSOSPML5",$JOB)
SET (VALMCNT,LINE,RXCNT,COUNT)=0
+18 SET (STATE,PATNAM,RXNFLL)=""
SET COUNT=0
+19 FOR
SET STATE=$ORDER(^TMP("PSOSPSRT",$JOB,STATE))
if STATE=""
QUIT
Begin DoDot:1
+20 DO SETLN^PSOSPMU1("PSOSPML5","Disclosed to:"_STATE,0,0,0)
+21 DO SETLN^PSOSPMU1("PSOSPML5","Info Disclosed: Name, DOB, SSN, Prescription Data, Home Address, Phone Number",0,0,0)
+22 FOR
SET PATNAM=$ORDER(^TMP("PSOSPSRT",$JOB,STATE,PATNAM))
if PATNAM=""
QUIT
Begin DoDot:2
+23 SET DFN=$PIECE(PATNAM,"^",2)
DO DEM^VADPT
SET L4SSN=$PIECE($PIECE(VADM(2),"^",2),"-",3)
+24 FOR
SET RXNFLL=$ORDER(^TMP("PSOSPSRT",$JOB,STATE,PATNAM,RXNFLL))
if RXNFLL=""
QUIT
Begin DoDot:3
+25 SET DISCDT=^TMP("PSOSPSRT",$JOB,STATE,PATNAM,RXNFLL)
+26 SET RXIEN=+RXNFLL
SET FILL=$PIECE(RXNFLL,"^",2)
SET RECTYPE=$PIECE(RXNFLL,"^",3)
+27 SET RXNUM=$$GET1^DIQ(52,RXIEN,.01)
+28 SET DRUGNAM=$$GET1^DIQ(52,RXIEN,6)
+29 SET COUNT=COUNT+1
+30 SET DSPLINE=$JUSTIFY(COUNT,4)_" "_$$FMTE^XLFDT(DISCDT,"2Y")
SET $EXTRACT(DSPLINE,14)=$EXTRACT($PIECE(PATNAM,"^"),1,20)_"("_L4SSN_")"
+31 SET $EXTRACT(DSPLINE,41)=RXNUM
SET $EXTRACT(DSPLINE,56)=$EXTRACT(DRUGNAM,1,25)
+32 DO SETLN^PSOSPMU1("PSOSPML5",DSPLINE,0,0,0)
+33 SET ^TMP("PSOSPML5",$JOB,COUNT,"RX")=RXIEN_"^"_FILL_"^"_RECTYPE
End DoDot:3
End DoDot:2
+34 DO SETLN^PSOSPMU1("PSOSPML5"," ",0,0,0)
End DoDot:1
+35 IF '$DATA(^TMP("PSOSPML5",$JOB))
Begin DoDot:1
+36 DO SETLN^PSOSPMU1("PSOSPML5","No data found for the date range selected.",0,0,0)
End DoDot:1
+37 SET VALMCNT=LINE
+38 QUIT
+39 ;
SEL ;Process selection of one entry
+1 NEW PSOSEL,XQORM,ORD,TITLE,RXINFO,LINE
+2 SET PSOSEL=+$PIECE(XQORNOD(0),"=",2)
IF 'PSOSEL
SET VALMSG="Invalid selection!"
SET VALMBCK="R"
QUIT
+3 SET RXINFO=$GET(^TMP("PSOSPML5",$JOB,PSOSEL,"RX"))
+4 IF 'RXINFO
SET VALMSG="Invalid selection!"
SET VALMBCK="R"
QUIT
+5 SET TITLE=VALM("TITLE")
+6 DO EN^PSOSPML4(+RXINFO,$PIECE(RXINFO,"^",2),$PIECE(RXINFO,"^",3))
+7 SET VALMBCK="R"
SET VALM("TITLE")=TITLE
+8 DO INIT
DO HDR
+9 QUIT
+10 ;
EXIT ;
+1 KILL ^TMP("PSOSPML5",$JOB)
+2 QUIT
+3 ;
HELP ; Listman HELP entry-point
+1 QUIT
