- 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 Mar 13, 2025@21:40 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
