PSOORAL1 ;BHAM ISC/SAB - Build Listman activity logs ;Jan 20, 2022@11:18:59
;;7.0;OUTPATIENT PHARMACY;**71,156,148,247,240,287,354,367,408,482,508,551,562,441,651,643**;DEC 1997;Build 35
;
;
N RX0,VALMCNT K DIR,DTOUT,DUOUT,DIRUT,^TMP("PSOAL",$J) S DA=$P(PSOLST(ORN),"^",2),RX0=^PSRX(DA,0),J=DA,RX2=$G(^(2)),R3=$G(^(3)),CMOP=$O(^PSRX(DA,4,0))
S IEN=0,DIR(0)="LO^1:"_$S(CMOP:10,1:9),DIR("A",1)=" ",DIR("A",2)="Select Activity Log by number",DIR("A",3)="1. Refill 2. Partial 3. Activity 4. Labels 5. Copay"
S DIR("A")=$S(CMOP:"6. ECME 7. SPMP 8. eRx Log 9. CMOP Events 10. All Logs ",1:"6. ECME 7. SPMP 8. eRx Log 9. All Logs")
S DIR("B")=$S(CMOP:10,1:9) D ^DIR S PSOELSE=+Y I +Y S Y=$S(CMOP&(Y[10):"1,2,3,4,5,6,7,8,9",'CMOP&(Y[9):"1,2,3,4,5,6,7,8",1:Y) S ACT=Y D FULL^VALM1 D
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Rx #: "_$P(RX0,"^")_" Original Fill Released: " I $P(RX2,"^",13) S DTT=$P(RX2,"^",13) D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT K DAT,DTT
.I $P(RX2,"^",15) S DTT=$P(RX2,"^",15) D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"(Returned to Stock "_DAT_")" K DAT,DTT
.;441 PAPI
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Routing: "_$S($P(RX0,"^",11)="W":"Window",$P(RX0,"^",11)="P":"Park",1:"Mail")_$S($P($G(^PSRX(DA,"OR1")),"^",5):" Finished by: "_$P(^VA(200,$P(^PSRX(DA,"OR1"),"^",5),0),"^"),1:"")
.D:$G(^PSRX(DA,"H"))]""&($P(PSOLST(ORN),"^",3)="HOLD") HLD^PSOORAL2
.F LOG=1:1:$L(ACT,",") Q:$P(ACT,",",LOG)']"" S LBL=$P(ACT,",",LOG) D @$S(LBL=1:"RF^PSOORAL2",LBL=2:"PAR^PSOORAL2",LBL=3:"ACT",LBL=5:"COPAY",LBL=6:"ECME",LBL=7:"SPMP",LBL=8:"ERX",LBL=9:"^PSORXVW2",1:"LBL")
I 'PSOELSE S VALMBCK="" K PSOELSE Q
K ST0,RFL,RFLL,RFL1,II,J,N,PHYS,L1,DIRUT,PSDIV,PSEXDT,MED,M1,FFX,DTT,DAT,R3,RTN,SIG,STA,P1,PL,P0,Z0,Z1,EXDT,IFN,DIR,DUOUT,DTOUT,PSOELSE
K LBL,I,RFDATE,%H,%I,RN,RFT
S PSOAL=IEN K IEN,ACT,LBL,LOG D EN^PSOORAL S VALMBCK="R"
Q
ACT ;activity log
D ACT^PSOORAL3
Q
;
LBL ;label log
N PSORDATA,PSONAME,X,PSOX
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Label Log:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date Rx Ref Printed By",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
I '$O(^PSRX(DA,"L",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Labels printed." Q
F L1=0:0 S L1=$O(^PSRX(DA,"L",L1)) Q:'L1 S LBL=^PSRX(DA,"L",L1,0),DTT=$P(^(0),"^") D DAT D
. S PSORDATA=""
. S $P(RN," ",26)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=L1_" "_DAT_" ",RFT=$S($P(LBL,"^",2):"REFILL "_$P(LBL,"^",2),1:"ORIGINAL"),RFT=RFT_$E(RN,$L(RFT)+1,26)
. S PSORDATA=$$LBLDATA^PSOORAL3(DA,LBL)
. K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(LBL,"^",4) D ^DIC
. S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$S($P($G(PSORDATA),U,2)]"":$P(PSORDATA,U,2),1:$P(Y,U,2))
. K ^UTILITY($J,"W") S X=$P(LBL,"^",3),(DIWR,DIWL)=1,DIWF="C69" D ^DIWP F PSOX=1:1:^UTILITY($J,"W",1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$S(PSOX=1:"Comments: ",1:" ")_$G(^UTILITY($J,"W",1,PSOX,0))
. I $P(PSORDATA,U)]"" S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "_$P(PSORDATA,U)
. N FDAMGDOC S FDAMGDOC=$G(^PSRX(DA,"L",L1,"FDA"))
. I FDAMGDOC'="" D
. . S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="FDA Med Guide: "_$E(FDAMGDOC,1,61)
. . I $L(FDAMGDOC)>61 D
. . . F Q:$E(FDAMGDOC,62,999)="" D
. . . . S FDAMGDOC=$E(FDAMGDOC,62,999),IEN=IEN+1
. . . . S ^TMP("PSOAL",$J,IEN,0)=$E(FDAMGDOC,1,61)
Q
;
COPAY ;Copay activity log
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Copay Activity Log:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date Reason Rx Ref Initiator Of Activity",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
I '$O(^PSRX(DA,"COPAY",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Copay activity to report" Q
F N=0:0 S N=$O(^PSRX(DA,"COPAY",N)) Q:'N S P1=^(N,0),DTT=P1\1 D DAT D
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" ",$P(RN," ",21)=" ",REA=$P(P1,"^",2),REA=$F("ARICE",REA)-1
.I REA D
..S STA=$P("ANNUAL CAP REACHED^COPAY RESET^IB-INITIATED COPAY^REMOVE COPAY CHARGE^RX EDITED^","^",REA)
..S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA_$E(RN,$L(STA)+1,21)
.E S $P(STA," ",21)=" ",^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA
.K STA,RN S $P(RN," ",15)=" ",RF=+$P(P1,"^",4)
.S RFT=$S(RF>0:"REFILL "_RF,1:"ORIGINAL")
.S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$E(RN,$L(RFT)+1,15)_$S($D(^VA(200,+$P(P1,"^",3),0)):$P(^(0),"^"),1:$P(P1,"^",3))
.S:$P(P1,"^",5)]""!($P(P1,"^",6)]"")!($P(P1,"^",7)]"") IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comment: "_$P(P1,"^",5)
.I $P(P1,"^",6)]"" S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_" Old value="_$P(P1,"^",6)_" New value="_$P(P1,"^",7)
Q
;
ECME ; ECME activity log
;
N DIWF,DIWL,DIWR,I,II,III,LINE,PSOAR,PSOCNT,PSOCNT1,PSOCOMMENT
N PSODATA,PSODATE,PSODATE1,PSOFIELDS,PSOFILE,PSOIENS,PSOLINE
N PSOREFILL,PSOREFILL1,PSOUSER,PSOUSER1
;
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="ECME Log:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date/Time Rx Ref Initiator Of Activity"
S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
;
; The comments from ACTIVITY LOG (#52.3) and REJECT INFO (#52.25)
; will be compiled in array PSOAR. This array will allow comments
; from each sub-file to be sorted in ascending order by date.
; A counter (PSOCNT) will be used to accommodate multiple
; comments with the exact same date/time.
;
; PSOAR array definition:
;
; PSOAR(PSODATE)=PSOCNT
; PSOAR(PSODATE,PSOCNT)=PSODATE^PSOUSER1^PSOREFILL1^PSOCOMMENT
; PSOAR(PSODATE,PSOCNT,PSOCNT1)=Additional Comments (if any)
;
; PSODATE ---- Date/time of comment - internal format
; PSOCNT ----- Counter of comments, by date
; PSOCNT1 ---- Counter of additional comments (if any)
; PSOUSER1 --- User who entered comment - external format
; PSOREFILL1 - Refill number - external format
; PSOCOMMENT - Comment
;
; Kill PSOAR to initialize array
;
K PSOAR
;
; Loop through ACTIVITY LOG (file #52.3) searching for ECME Entries.
; ECME Entries are defined as REASON="M".
;
; ACTIVITY LOG Fields:
; .01 = Activity Log (Date)
; .02 = Reason
; .03 = Initiator of Activity (User)
; .04 = RX Reference (Refill #)
; .05 = Comment
;
; The above fields will be stored in array PSODATA via a call to ^DIQ.
;
S I=0
F S I=$O(^PSRX(DA,"A",I)) Q:'I D
. ;
. S PSOCNT=0
. S PSOFILE=52.3
. S PSOIENS=I_","_DA_","
. S PSOFIELDS=".01;.02;.03;.04;.05"
. K PSODATA
. ;
. D GETS^DIQ(PSOFILE,I_","_DA,PSOFIELDS,"IE","PSODATA")
. ;
. ; If reason is not M (ECME), do not include comment.
. ;
. I $G(PSODATA(PSOFILE,PSOIENS,.02,"I"))'="M" Q
. ;
. S PSODATE=$G(PSODATA(PSOFILE,PSOIENS,.01,"I"))
. S PSOUSER1=$G(PSODATA(PSOFILE,PSOIENS,.03,"E"))
. S PSOREFILL1=$S('$G(PSODATA(PSOFILE,PSOIENS,.04,"I")):"ORIGINAL",1:"REFILL "_PSODATA(PSOFILE,PSOIENS,.04,"I"))
. S PSOCOMMENT=$G(PSODATA(PSOFILE,PSOIENS,.05,"I"))
. ;
. S PSOCNT=$G(PSOAR(PSODATE))+1
. S PSOAR(PSODATE)=PSOCNT
. S PSOAR(PSODATE,PSOCNT)=$$FMTE^XLFDT(PSODATE,2)_U_PSOUSER1_U_PSOREFILL1_U_PSOCOMMENT
. ;
. ; Node 2 of the ACTIVITY LOG contains any additional comments.
. ; Loop through OTHER COMMENTS sub-file (file #52.34) to add to PSOAR
. ; for reporting.
. ;
. I $D(^PSRX(DA,"A",I,2)) D
. . S PSOCNT1=0
. . S II=0
. . F S II=$O(^PSRX(DA,"A",I,2,II)) Q:'II D
. . . S PSOCNT1=PSOCNT1+1
. . . S PSOAR(PSODATE,PSOCNT,PSOCNT1)=$$GET1^DIQ(52.34,II_","_I_","_DA,.01)
;
; Loop through REJECT INFO Comments (File #52.2551) searching for
; User Created entries.
; User Created entries are defined as User'="POSTMASTER"
;
; REJECT INFO Comments Fields:
; .01 = Date/Time
; 1 = User
; 2 = Comments
;
; The above fields will be stored in array PSODATA via a call to ^DIQ.
;
S I=0 F S I=$O(^PSRX(DA,"REJ",I)) Q:'I S PSODATE=0 F S PSODATE=$O(^PSRX(DA,"REJ",I,"COM","B",PSODATE)) Q:'PSODATE D
. S III=0 F S III=$O(^PSRX(DA,"REJ",I,"COM","B",PSODATE,III)) Q:'III D
. . S REC=$G(^PSRX(DA,"REJ",I,"COM",III,0))
. . S PSOUSER=$P(REC,U,2),PSOUSER1=$P($G(^VA(200,PSOUSER,0)),U,1)
. . S PSOCOMMENT=$P(REC,U,3)
. . ;
. . S PSOREFILL=$$GET1^DIQ(52.25,I_","_DA,5)
. . I PSOREFILL=0 S PSOREFILL1="ORIGINAL"
. . E S PSOREFILL1="REFILL #"_PSOREFILL
. . ;
. . S PSOCNT=$G(PSOAR(PSODATE))+1
. . S PSOAR(PSODATE)=PSOCNT
. . S PSOAR(PSODATE,PSOCNT)=$$FMTE^XLFDT(PSODATE,2)_U_PSOUSER1_U_PSOREFILL1_U_PSOCOMMENT
;
; If PSOAR array contains no data, there is No ECME Activity to report.
;
I '$D(PSOAR) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO ECME Activity to report" Q
;
; Loop through PSOAR array and assign data to ^TMP array for reporting.
;
; PSOLINE = ECME Log Entry line number.
;
S (PSODATE1,PSOREFILL,PSOUSER)=""
S PSODATE="" F S PSODATE=$O(PSOAR(PSODATE)) Q:PSODATE="" D
. S PSOCNT="" F S PSOCNT=$O(PSOAR(PSODATE,PSOCNT)) Q:PSOCNT="" D
. . S PSODATA=$G(PSOAR(PSODATE,PSOCNT))
. . ;
. . S IEN=IEN+1
. . I '$D(PSOLINE) S PSOLINE=0
. . S PSOLINE=PSOLINE+1
. . S PSODATE1=$P(PSODATA,U)
. . S PSOUSER=$P(PSODATA,U,2)
. . S PSOREFILL=$P(PSODATA,U,3)
. . S LINE=PSOLINE
. . S $E(LINE,5)=PSODATE1
. . S $E(LINE,25)=PSOREFILL
. . S $E(LINE,41)=PSOUSER
. . S ^TMP("PSOAL",$J,IEN,0)=LINE
. . ;
. . ; D ^DIWP formats comments into ^UTILITY($J,"W")
. . ;
. . S PSOCOMMENT=$P(PSODATA,"^",4)
. . ;
. . K ^UTILITY($J,"W")
. . ;
. . S X="Comments: "_PSOCOMMENT
. . S (DIWR,DIWL)=1,DIWF="C80"
. . D ^DIWP
. . ;
. . ; Additional comments (if any)
. . ;
. . S PSOCNT1=""
. . F S PSOCNT1=$O(PSOAR(PSODATE,PSOCNT,PSOCNT1)) Q:PSOCNT1="" D
. . . S X=PSOAR(PSODATE,PSOCNT,PSOCNT1)
. . . S DIWF="C80I10"
. . . D ^DIWP
. . ;
. . ; Loop through ^UTILITY($J,"W"), adding comments to ^TMP
. . ;
. . F I=1:1:^UTILITY($J,"W",1) D
. . . S IEN=IEN+1
. . . S ^TMP("PSOAL",$J,IEN,0)=$G(^UTILITY($J,"W",1,I,0))
;
D DISPREJ
;
K ^UTILITY($J,"W"),DIWR,DIWF,DIWL
Q
;
SPMP ; SPMP (State Prescription Monitoring Program) Log
N FILL,BAT,LOG,BAT0,LOG0
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1
S ^TMP("PSOAL",$J,IEN,0)="SPMP (State Prescription Monitoring Program) Log:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Date/Time Fill Type Exp. Type Bat# Filename"
S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",80)="="
I '$D(^PS(58.42,"ARX",DA)) D Q
. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Export Log for this prescription."
S FILL=""
F S FILL=$O(^PS(58.42,"ARX",DA,FILL)) Q:FILL="" D
. S BAT=0 F S BAT=$O(^PS(58.42,"ARX",DA,FILL,BAT)) Q:'BAT D
. . S LOG=0 F S LOG=$O(^PS(58.42,"ARX",DA,FILL,BAT,LOG)) Q:'LOG D
. . . S BAT0=$G(^PS(58.42,BAT,0)),LOG0=$G(^PS(58.42,BAT,"RX",LOG,0))
. . . I '$P(BAT0,"^",10) Q
. . . S IEN=IEN+1,LINE=$$FMTE^XLFDT($P(BAT0,"^",10),2),$E(LINE,17)=$J($P(LOG0,"^",2),4)
. . . S $E(LINE,22)=$$GET1^DIQ(58.42001,LOG_","_BAT,2),$E(LINE,29)=$$GET1^DIQ(58.42,BAT,2)
. . . S $E(LINE,39)=BAT,$E(LINE,45)=$E($$GET1^DIQ(58.42,BAT,6),1,35)
. . . S ^TMP("PSOAL",$J,IEN,0)=LINE
Q
;
DISPREJ ;
N LN,SEQ,REJ,PRI,VAR,X,X1,X2,I,RFT
I '$D(^PSRX(DA,"REJ")) Q
S PRI="PSOAL",$P(LN,"=",80)="",SEQ=0
S IEN=$G(IEN)+1,^TMP(PRI,$J,IEN,0)=" "
S IEN=IEN+1,^TMP(PRI,$J,IEN,0)="ECME REJECT Log:"
S IEN=IEN+1,^TMP(PRI,$J,IEN,0)="# Date/Time Rcvd Rx Ref Reject Type STATUS Date/Time Resolved"
S IEN=IEN+1,^TMP(PRI,$J,IEN,0)=LN
F REJ=0:0 S REJ=$O(^PSRX(DA,"REJ",REJ)) Q:'REJ D
. S VAR=$G(^PSRX(DA,"REJ",REJ,0))
. S RFT=+$P(VAR,"^",4)
. S SEQ=SEQ+1,X=SEQ,$E(X,4)=$$FMTE^XLFDT($P(VAR,"^",2),2),$E(X,22)=$S(RFT:"REFILL "_RFT,1:"ORIGINAL")
. S $E(X,32)=$S(+VAR=79:"REFILL TOO SOON",+VAR=88!(+VAR=943):"DUR",1:$E($$EXP^PSOREJP1($P(VAR,"^",1)),1,15)) ;can't + default because values can be 07, 08, etc.
. S $E(X,48)=$S($P(VAR,"^",5):"RESOLVED",1:"UNRESOLVED")
. S:$P(VAR,"^",6) $E(X,59)=$$FMTE^XLFDT($P(VAR,"^",6),2)
. S IEN=IEN+1,^TMP(PRI,$J,IEN,0)=X
. I $P(VAR,"^",5) D
. . S IEN=IEN+1,X=$$GET1^DIQ(52.25,REJ_","_DA,12)
. . S X1=$$GET1^DIQ(52.25,REJ_","_DA,13) S:X1'="" X=X1_" ("_X_")"
. . F I=1:1 Q:X="" D
. . . S ^TMP(PRI,$J,IEN,0)=$S(I=1:"Comments: ",1:" ")_$E(X,1,69)
. . . S X=$E(X,70,999) S:X'="" IEN=IEN+1
Q
;
ERX ; eRx Log
;/BLB/ PSO*7.0*551 - BEGIN CHANGE - ERX LOG
N CNT,G,STR,X,I,TMP,N,ERXREC,ERXCHK,DAT,PSOACBRV,P1
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="eRx Activity Log:"
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date Reason Rx Ref Initiator Of Activity"
S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",80)="="
S ERXCHK=0 F S ERXCHK=$O(^PSRX(DA,"A",ERXCHK)) Q:'ERXCHK D
.I $P(^PSRX(DA,"A",ERXCHK,0),U,2)="O" S ERXREC=1
I '$G(ERXREC) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are no eRx activity logs." Q
S CNT=0
F N=0:0 S N=$O(^PSRX(DA,"A",N)) Q:'N S P1=^(N,0) D
.I $P(P1,"^",2)'="O" Q
.S DAT=$$FMTE^XLFDT($P(P1,"^"),2)_" "
.S IEN=IEN+1,CNT=CNT+1,^TMP("PSOAL",$J,IEN,0)=CNT_" "_$E(DAT,1,21),$P(RN," ",15)=" ",REA=$P(P1,"^",2)
.I $P(P1,"^",5)]"" N PSOACBRK,PSOACBRV D
..S PSOACBRV=$P(P1,"^",5)
..;Use fileman for parsing
..K ^UTILITY($J,"W") S X="Comments: "_PSOACBRV,(DIWR,DIWL)=1,DIWF="C80" D ^DIWP F I=1:1:^UTILITY($J,"W",1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$G(^UTILITY($J,"W",1,I,0))
.I $P($G(^PSRX(DA,"A",N,1)),"^")]"" S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",5)=$P($G(^PSRX(DA,"A",N,1)),"^") I $P($G(^PSRX(DA,"A",N,1)),"^",2)]"" S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_":"_$P($G(^PSRX(DA,"A",N,1)),"^",2)
.I $O(^PSRX(DA,"A",N,2,0)) F I=0:0 S I=$O(^PSRX(DA,"A",N,2,I)) Q:'I S MIG=^PSRX(DA,"A",N,2,I,0) D
..S:MIG["Mail Tracking Info.: " IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" "
..F SG=1:1:$L(MIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(MIG," ",SG)
K MIG,SG,I,^UTILITY($J,"W"),DIWF,DIWL,DIWR
Q
;/BLB/ PSO*7.0*551 - END CHANGE
DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORAL1 14346 printed Dec 13, 2024@02:31:43 Page 2
PSOORAL1 ;BHAM ISC/SAB - Build Listman activity logs ;Jan 20, 2022@11:18:59
+1 ;;7.0;OUTPATIENT PHARMACY;**71,156,148,247,240,287,354,367,408,482,508,551,562,441,651,643**;DEC 1997;Build 35
+2 ;
+3 ;
+4 NEW RX0,VALMCNT
KILL DIR,DTOUT,DUOUT,DIRUT,^TMP("PSOAL",$JOB)
SET DA=$PIECE(PSOLST(ORN),"^",2)
SET RX0=^PSRX(DA,0)
SET J=DA
SET RX2=$GET(^(2))
SET R3=$GET(^(3))
SET CMOP=$ORDER(^PSRX(DA,4,0))
+5 SET IEN=0
SET DIR(0)="LO^1:"_$SELECT(CMOP:10,1:9)
SET DIR("A",1)=" "
SET DIR("A",2)="Select Activity Log by number"
SET DIR("A",3)="1. Refill 2. Partial 3. Activity 4. Labels 5. Copay"
+6 SET DIR("A")=$SELECT(CMOP:"6. ECME 7. SPMP 8. eRx Log 9. CMOP Events 10. All Logs ",1:"6. ECME 7. SPMP 8. eRx Log 9. All Logs")
+7 SET DIR("B")=$SELECT(CMOP:10,1:9)
DO ^DIR
SET PSOELSE=+Y
IF +Y
SET Y=$SELECT(CMOP&(Y[10):"1,2,3,4,5,6,7,8,9",'CMOP&(Y[9):"1,2,3,4,5,6,7,8",1:Y)
SET ACT=Y
DO FULL^VALM1
Begin DoDot:1
+8 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Rx #: "_$PIECE(RX0,"^")_" Original Fill Released: "
IF $PIECE(RX2,"^",13)
SET DTT=$PIECE(RX2,"^",13)
DO DAT
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_DAT
KILL DAT,DTT
+9 IF $PIECE(RX2,"^",15)
SET DTT=$PIECE(RX2,"^",15)
DO DAT
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"(Returned to Stock "_DAT_")"
KILL DAT,DTT
+10 ;441 PAPI
+11 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Routing: "_$SELECT($PIECE(RX0,"^",11)="W":"Window",$PIECE(RX0,"^",11)="P":"Park",1:"Mail")_$SELECT($PIECE($GET(^PSRX(DA,"OR1")),"^",5):" Finished by: "_$PIECE(^VA(200,$PIECE(^PSRX(DA,"OR1"),"^",5),0),"
^"),1:"")
+12 if $GET(^PSRX(DA,"H"))]""&($PIECE(PSOLST(ORN),"^",3)="HOLD")
DO HLD^PSOORAL2
+13 FOR LOG=1:1:$LENGTH(ACT,",")
if $PIECE(ACT,",",LOG)']""
QUIT
SET LBL=$PIECE(ACT,",",LOG)
DO @$SELECT(LBL=1:"RF^PSOORAL2",LBL=2:"PAR^PSOORAL2",LBL=3:"ACT",LBL=5:"COPAY",LBL=6:"ECME",LBL=7:"SPMP",LBL=8:"ERX",LBL=9:"^PSORXVW2",1:"LBL")
End DoDot:1
+14 IF 'PSOELSE
SET VALMBCK=""
KILL PSOELSE
QUIT
+15 KILL ST0,RFL,RFLL,RFL1,II,J,N,PHYS,L1,DIRUT,PSDIV,PSEXDT,MED,M1,FFX,DTT,DAT,R3,RTN,SIG,STA,P1,PL,P0,Z0,Z1,EXDT,IFN,DIR,DUOUT,DTOUT,PSOELSE
+16 KILL LBL,I,RFDATE,%H,%I,RN,RFT
+17 SET PSOAL=IEN
KILL IEN,ACT,LBL,LOG
DO EN^PSOORAL
SET VALMBCK="R"
+18 QUIT
ACT ;activity log
+1 DO ACT^PSOORAL3
+2 QUIT
+3 ;
LBL ;label log
+1 NEW PSORDATA,PSONAME,X,PSOX
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Label Log:"
+3 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Date Rx Ref Printed By"
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
+4 IF '$ORDER(^PSRX(DA,"L",0))
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Labels printed."
QUIT
+5 FOR L1=0:0
SET L1=$ORDER(^PSRX(DA,"L",L1))
if 'L1
QUIT
SET LBL=^PSRX(DA,"L",L1,0)
SET DTT=$PIECE(^(0),"^")
DO DAT
Begin DoDot:1
+6 SET PSORDATA=""
+7 SET $PIECE(RN," ",26)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=L1_" "_DAT_" "
SET RFT=$SELECT($PIECE(LBL,"^",2):"REFILL "_$PIECE(LBL,"^",2),1:"ORIGINAL")
SET RFT=RFT_$EXTRACT(RN,$LENGTH(RFT)+1,26)
+8 SET PSORDATA=$$LBLDATA^PSOORAL3(DA,LBL)
+9 KILL DIC,X,Y
SET DIC="^VA(200,"
SET DIC(0)="N,Z"
SET X=$PIECE(LBL,"^",4)
DO ^DIC
+10 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RFT_$SELECT($PIECE($GET(PSORDATA),U,2)]"":$PIECE(PSORDATA,U,2),1:$PIECE(Y,U,2))
+11 KILL ^UTILITY($JOB,"W")
SET X=$PIECE(LBL,"^",3)
SET (DIWR,DIWL)=1
SET DIWF="C69"
DO ^DIWP
FOR PSOX=1:1:^UTILITY($JOB,"W",1)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=$SELECT(PSOX=1:"Comments: ",1:" ")_$GET(^UTILITY($JOB,"W",1,PSOX,0))
+12 IF $PIECE(PSORDATA,U)]""
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "_$PIECE(PSORDATA,U)
+13 NEW FDAMGDOC
SET FDAMGDOC=$GET(^PSRX(DA,"L",L1,"FDA"))
+14 IF FDAMGDOC'=""
Begin DoDot:2
+15 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="FDA Med Guide: "_$EXTRACT(FDAMGDOC,1,61)
+16 IF $LENGTH(FDAMGDOC)>61
Begin DoDot:3
+17 FOR
if $EXTRACT(FDAMGDOC,62,999)=""
QUIT
Begin DoDot:4
+18 SET FDAMGDOC=$EXTRACT(FDAMGDOC,62,999)
SET IEN=IEN+1
+19 SET ^TMP("PSOAL",$JOB,IEN,0)=$EXTRACT(FDAMGDOC,1,61)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
COPAY ;Copay activity log
+1 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Copay Activity Log:"
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Date Reason Rx Ref Initiator Of Activity"
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
+3 IF '$ORDER(^PSRX(DA,"COPAY",0))
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There's NO Copay activity to report"
QUIT
+4 FOR N=0:0
SET N=$ORDER(^PSRX(DA,"COPAY",N))
if 'N
QUIT
SET P1=^(N,0)
SET DTT=P1\1
DO DAT
Begin DoDot:1
+5 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=N_" "_DAT_" "
SET $PIECE(RN," ",21)=" "
SET REA=$PIECE(P1,"^",2)
SET REA=$FIND("ARICE",REA)-1
+6 IF REA
Begin DoDot:2
+7 SET STA=$PIECE("ANNUAL CAP REACHED^COPAY RESET^IB-INITIATED COPAY^REMOVE COPAY CHARGE^RX EDITED^","^",REA)
+8 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA_$EXTRACT(RN,$LENGTH(STA)+1,21)
End DoDot:2
+9 IF '$TEST
SET $PIECE(STA," ",21)=" "
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA
+10 KILL STA,RN
SET $PIECE(RN," ",15)=" "
SET RF=+$PIECE(P1,"^",4)
+11 SET RFT=$SELECT(RF>0:"REFILL "_RF,1:"ORIGINAL")
+12 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RFT_$EXTRACT(RN,$LENGTH(RFT)+1,15)_$SELECT($DATA(^VA(200,+$PIECE(P1,"^",3),0)):$PIECE(^(0),"^"),1:$PIECE(P1,"^",3))
+13 if $PIECE(P1,"^",5)]""!($PIECE(P1,"^",6)]"")!($PIECE(P1,"^",7)]"")
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Comment: "_$PIECE(P1,"^",5)
+14 IF $PIECE(P1,"^",6)]""
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_" Old value="_$PIECE(P1,"^",6)_" New value="_$PIECE(P1,"^",7)
End DoDot:1
+15 QUIT
+16 ;
ECME ; ECME activity log
+1 ;
+2 NEW DIWF,DIWL,DIWR,I,II,III,LINE,PSOAR,PSOCNT,PSOCNT1,PSOCOMMENT
+3 NEW PSODATA,PSODATE,PSODATE1,PSOFIELDS,PSOFILE,PSOIENS,PSOLINE
+4 NEW PSOREFILL,PSOREFILL1,PSOUSER,PSOUSER1
+5 ;
+6 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
+7 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="ECME Log:"
+8 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Date/Time Rx Ref Initiator Of Activity"
+9 SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
+10 ;
+11 ; The comments from ACTIVITY LOG (#52.3) and REJECT INFO (#52.25)
+12 ; will be compiled in array PSOAR. This array will allow comments
+13 ; from each sub-file to be sorted in ascending order by date.
+14 ; A counter (PSOCNT) will be used to accommodate multiple
+15 ; comments with the exact same date/time.
+16 ;
+17 ; PSOAR array definition:
+18 ;
+19 ; PSOAR(PSODATE)=PSOCNT
+20 ; PSOAR(PSODATE,PSOCNT)=PSODATE^PSOUSER1^PSOREFILL1^PSOCOMMENT
+21 ; PSOAR(PSODATE,PSOCNT,PSOCNT1)=Additional Comments (if any)
+22 ;
+23 ; PSODATE ---- Date/time of comment - internal format
+24 ; PSOCNT ----- Counter of comments, by date
+25 ; PSOCNT1 ---- Counter of additional comments (if any)
+26 ; PSOUSER1 --- User who entered comment - external format
+27 ; PSOREFILL1 - Refill number - external format
+28 ; PSOCOMMENT - Comment
+29 ;
+30 ; Kill PSOAR to initialize array
+31 ;
+32 KILL PSOAR
+33 ;
+34 ; Loop through ACTIVITY LOG (file #52.3) searching for ECME Entries.
+35 ; ECME Entries are defined as REASON="M".
+36 ;
+37 ; ACTIVITY LOG Fields:
+38 ; .01 = Activity Log (Date)
+39 ; .02 = Reason
+40 ; .03 = Initiator of Activity (User)
+41 ; .04 = RX Reference (Refill #)
+42 ; .05 = Comment
+43 ;
+44 ; The above fields will be stored in array PSODATA via a call to ^DIQ.
+45 ;
+46 SET I=0
+47 FOR
SET I=$ORDER(^PSRX(DA,"A",I))
if 'I
QUIT
Begin DoDot:1
+48 ;
+49 SET PSOCNT=0
+50 SET PSOFILE=52.3
+51 SET PSOIENS=I_","_DA_","
+52 SET PSOFIELDS=".01;.02;.03;.04;.05"
+53 KILL PSODATA
+54 ;
+55 DO GETS^DIQ(PSOFILE,I_","_DA,PSOFIELDS,"IE","PSODATA")
+56 ;
+57 ; If reason is not M (ECME), do not include comment.
+58 ;
+59 IF $GET(PSODATA(PSOFILE,PSOIENS,.02,"I"))'="M"
QUIT
+60 ;
+61 SET PSODATE=$GET(PSODATA(PSOFILE,PSOIENS,.01,"I"))
+62 SET PSOUSER1=$GET(PSODATA(PSOFILE,PSOIENS,.03,"E"))
+63 SET PSOREFILL1=$SELECT('$GET(PSODATA(PSOFILE,PSOIENS,.04,"I")):"ORIGINAL",1:"REFILL "_PSODATA(PSOFILE,PSOIENS,.04,"I"))
+64 SET PSOCOMMENT=$GET(PSODATA(PSOFILE,PSOIENS,.05,"I"))
+65 ;
+66 SET PSOCNT=$GET(PSOAR(PSODATE))+1
+67 SET PSOAR(PSODATE)=PSOCNT
+68 SET PSOAR(PSODATE,PSOCNT)=$$FMTE^XLFDT(PSODATE,2)_U_PSOUSER1_U_PSOREFILL1_U_PSOCOMMENT
+69 ;
+70 ; Node 2 of the ACTIVITY LOG contains any additional comments.
+71 ; Loop through OTHER COMMENTS sub-file (file #52.34) to add to PSOAR
+72 ; for reporting.
+73 ;
+74 IF $DATA(^PSRX(DA,"A",I,2))
Begin DoDot:2
+75 SET PSOCNT1=0
+76 SET II=0
+77 FOR
SET II=$ORDER(^PSRX(DA,"A",I,2,II))
if 'II
QUIT
Begin DoDot:3
+78 SET PSOCNT1=PSOCNT1+1
+79 SET PSOAR(PSODATE,PSOCNT,PSOCNT1)=$$GET1^DIQ(52.34,II_","_I_","_DA,.01)
End DoDot:3
End DoDot:2
End DoDot:1
+80 ;
+81 ; Loop through REJECT INFO Comments (File #52.2551) searching for
+82 ; User Created entries.
+83 ; User Created entries are defined as User'="POSTMASTER"
+84 ;
+85 ; REJECT INFO Comments Fields:
+86 ; .01 = Date/Time
+87 ; 1 = User
+88 ; 2 = Comments
+89 ;
+90 ; The above fields will be stored in array PSODATA via a call to ^DIQ.
+91 ;
+92 SET I=0
FOR
SET I=$ORDER(^PSRX(DA,"REJ",I))
if 'I
QUIT
SET PSODATE=0
FOR
SET PSODATE=$ORDER(^PSRX(DA,"REJ",I,"COM","B",PSODATE))
if 'PSODATE
QUIT
Begin DoDot:1
+93 SET III=0
FOR
SET III=$ORDER(^PSRX(DA,"REJ",I,"COM","B",PSODATE,III))
if 'III
QUIT
Begin DoDot:2
+94 SET REC=$GET(^PSRX(DA,"REJ",I,"COM",III,0))
+95 SET PSOUSER=$PIECE(REC,U,2)
SET PSOUSER1=$PIECE($GET(^VA(200,PSOUSER,0)),U,1)
+96 SET PSOCOMMENT=$PIECE(REC,U,3)
+97 ;
+98 SET PSOREFILL=$$GET1^DIQ(52.25,I_","_DA,5)
+99 IF PSOREFILL=0
SET PSOREFILL1="ORIGINAL"
+100 IF '$TEST
SET PSOREFILL1="REFILL #"_PSOREFILL
+101 ;
+102 SET PSOCNT=$GET(PSOAR(PSODATE))+1
+103 SET PSOAR(PSODATE)=PSOCNT
+104 SET PSOAR(PSODATE,PSOCNT)=$$FMTE^XLFDT(PSODATE,2)_U_PSOUSER1_U_PSOREFILL1_U_PSOCOMMENT
End DoDot:2
End DoDot:1
+105 ;
+106 ; If PSOAR array contains no data, there is No ECME Activity to report.
+107 ;
+108 IF '$DATA(PSOAR)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There's NO ECME Activity to report"
QUIT
+109 ;
+110 ; Loop through PSOAR array and assign data to ^TMP array for reporting.
+111 ;
+112 ; PSOLINE = ECME Log Entry line number.
+113 ;
+114 SET (PSODATE1,PSOREFILL,PSOUSER)=""
+115 SET PSODATE=""
FOR
SET PSODATE=$ORDER(PSOAR(PSODATE))
if PSODATE=""
QUIT
Begin DoDot:1
+116 SET PSOCNT=""
FOR
SET PSOCNT=$ORDER(PSOAR(PSODATE,PSOCNT))
if PSOCNT=""
QUIT
Begin DoDot:2
+117 SET PSODATA=$GET(PSOAR(PSODATE,PSOCNT))
+118 ;
+119 SET IEN=IEN+1
+120 IF '$DATA(PSOLINE)
SET PSOLINE=0
+121 SET PSOLINE=PSOLINE+1
+122 SET PSODATE1=$PIECE(PSODATA,U)
+123 SET PSOUSER=$PIECE(PSODATA,U,2)
+124 SET PSOREFILL=$PIECE(PSODATA,U,3)
+125 SET LINE=PSOLINE
+126 SET $EXTRACT(LINE,5)=PSODATE1
+127 SET $EXTRACT(LINE,25)=PSOREFILL
+128 SET $EXTRACT(LINE,41)=PSOUSER
+129 SET ^TMP("PSOAL",$JOB,IEN,0)=LINE
+130 ;
+131 ; D ^DIWP formats comments into ^UTILITY($J,"W")
+132 ;
+133 SET PSOCOMMENT=$PIECE(PSODATA,"^",4)
+134 ;
+135 KILL ^UTILITY($JOB,"W")
+136 ;
+137 SET X="Comments: "_PSOCOMMENT
+138 SET (DIWR,DIWL)=1
SET DIWF="C80"
+139 DO ^DIWP
+140 ;
+141 ; Additional comments (if any)
+142 ;
+143 SET PSOCNT1=""
+144 FOR
SET PSOCNT1=$ORDER(PSOAR(PSODATE,PSOCNT,PSOCNT1))
if PSOCNT1=""
QUIT
Begin DoDot:3
+145 SET X=PSOAR(PSODATE,PSOCNT,PSOCNT1)
+146 SET DIWF="C80I10"
+147 DO ^DIWP
End DoDot:3
+148 ;
+149 ; Loop through ^UTILITY($J,"W"), adding comments to ^TMP
+150 ;
+151 FOR I=1:1:^UTILITY($JOB,"W",1)
Begin DoDot:3
+152 SET IEN=IEN+1
+153 SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^UTILITY($JOB,"W",1,I,0))
End DoDot:3
End DoDot:2
End DoDot:1
+154 ;
+155 DO DISPREJ
+156 ;
+157 KILL ^UTILITY($JOB,"W"),DIWR,DIWF,DIWL
+158 QUIT
+159 ;
SPMP ; SPMP (State Prescription Monitoring Program) Log
+1 NEW FILL,BAT,LOG,BAT0,LOG0
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
+3 SET ^TMP("PSOAL",$JOB,IEN,0)="SPMP (State Prescription Monitoring Program) Log:"
+4 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Date/Time Fill Type Exp. Type Bat# Filename"
+5 SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",80)="="
+6 IF '$DATA(^PS(58.42,"ARX",DA))
Begin DoDot:1
+7 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There's NO Export Log for this prescription."
End DoDot:1
QUIT
+8 SET FILL=""
+9 FOR
SET FILL=$ORDER(^PS(58.42,"ARX",DA,FILL))
if FILL=""
QUIT
Begin DoDot:1
+10 SET BAT=0
FOR
SET BAT=$ORDER(^PS(58.42,"ARX",DA,FILL,BAT))
if 'BAT
QUIT
Begin DoDot:2
+11 SET LOG=0
FOR
SET LOG=$ORDER(^PS(58.42,"ARX",DA,FILL,BAT,LOG))
if 'LOG
QUIT
Begin DoDot:3
+12 SET BAT0=$GET(^PS(58.42,BAT,0))
SET LOG0=$GET(^PS(58.42,BAT,"RX",LOG,0))
+13 IF '$PIECE(BAT0,"^",10)
QUIT
+14 SET IEN=IEN+1
SET LINE=$$FMTE^XLFDT($PIECE(BAT0,"^",10),2)
SET $EXTRACT(LINE,17)=$JUSTIFY($PIECE(LOG0,"^",2),4)
+15 SET $EXTRACT(LINE,22)=$$GET1^DIQ(58.42001,LOG_","_BAT,2)
SET $EXTRACT(LINE,29)=$$GET1^DIQ(58.42,BAT,2)
+16 SET $EXTRACT(LINE,39)=BAT
SET $EXTRACT(LINE,45)=$EXTRACT($$GET1^DIQ(58.42,BAT,6),1,35)
+17 SET ^TMP("PSOAL",$JOB,IEN,0)=LINE
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
DISPREJ ;
+1 NEW LN,SEQ,REJ,PRI,VAR,X,X1,X2,I,RFT
+2 IF '$DATA(^PSRX(DA,"REJ"))
QUIT
+3 SET PRI="PSOAL"
SET $PIECE(LN,"=",80)=""
SET SEQ=0
+4 SET IEN=$GET(IEN)+1
SET ^TMP(PRI,$JOB,IEN,0)=" "
+5 SET IEN=IEN+1
SET ^TMP(PRI,$JOB,IEN,0)="ECME REJECT Log:"
+6 SET IEN=IEN+1
SET ^TMP(PRI,$JOB,IEN,0)="# Date/Time Rcvd Rx Ref Reject Type STATUS Date/Time Resolved"
+7 SET IEN=IEN+1
SET ^TMP(PRI,$JOB,IEN,0)=LN
+8 FOR REJ=0:0
SET REJ=$ORDER(^PSRX(DA,"REJ",REJ))
if 'REJ
QUIT
Begin DoDot:1
+9 SET VAR=$GET(^PSRX(DA,"REJ",REJ,0))
+10 SET RFT=+$PIECE(VAR,"^",4)
+11 SET SEQ=SEQ+1
SET X=SEQ
SET $EXTRACT(X,4)=$$FMTE^XLFDT($PIECE(VAR,"^",2),2)
SET $EXTRACT(X,22)=$SELECT(RFT:"REFILL "_RFT,1:"ORIGINAL")
+12 ;can't + default because values can be 07, 08, etc.
SET $EXTRACT(X,32)=$SELECT(+VAR=79:"REFILL TOO SOON",+VAR=88!(+VAR=943):"DUR",1:$EXTRACT($$EXP^PSOREJP1($PIECE(VAR,"^",1)),1,15))
+13 SET $EXTRACT(X,48)=$SELECT($PIECE(VAR,"^",5):"RESOLVED",1:"UNRESOLVED")
+14 if $PIECE(VAR,"^",6)
SET $EXTRACT(X,59)=$$FMTE^XLFDT($PIECE(VAR,"^",6),2)
+15 SET IEN=IEN+1
SET ^TMP(PRI,$JOB,IEN,0)=X
+16 IF $PIECE(VAR,"^",5)
Begin DoDot:2
+17 SET IEN=IEN+1
SET X=$$GET1^DIQ(52.25,REJ_","_DA,12)
+18 SET X1=$$GET1^DIQ(52.25,REJ_","_DA,13)
if X1'=""
SET X=X1_" ("_X_")"
+19 FOR I=1:1
if X=""
QUIT
Begin DoDot:3
+20 SET ^TMP(PRI,$JOB,IEN,0)=$SELECT(I=1:"Comments: ",1:" ")_$EXTRACT(X,1,69)
+21 SET X=$EXTRACT(X,70,999)
if X'=""
SET IEN=IEN+1
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
ERX ; eRx Log
+1 ;/BLB/ PSO*7.0*551 - BEGIN CHANGE - ERX LOG
+2 NEW CNT,G,STR,X,I,TMP,N,ERXREC,ERXCHK,DAT,PSOACBRV,P1
+3 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
+4 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="eRx Activity Log:"
+5 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Date Reason Rx Ref Initiator Of Activity"
+6 SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",80)="="
+7 SET ERXCHK=0
FOR
SET ERXCHK=$ORDER(^PSRX(DA,"A",ERXCHK))
if 'ERXCHK
QUIT
Begin DoDot:1
+8 IF $PIECE(^PSRX(DA,"A",ERXCHK,0),U,2)="O"
SET ERXREC=1
End DoDot:1
+9 IF '$GET(ERXREC)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There are no eRx activity logs."
QUIT
+10 SET CNT=0
+11 FOR N=0:0
SET N=$ORDER(^PSRX(DA,"A",N))
if 'N
QUIT
SET P1=^(N,0)
Begin DoDot:1
+12 IF $PIECE(P1,"^",2)'="O"
QUIT
+13 SET DAT=$$FMTE^XLFDT($PIECE(P1,"^"),2)_" "
+14 SET IEN=IEN+1
SET CNT=CNT+1
SET ^TMP("PSOAL",$JOB,IEN,0)=CNT_" "_$EXTRACT(DAT,1,21)
SET $PIECE(RN," ",15)=" "
SET REA=$PIECE(P1,"^",2)
+15 IF $PIECE(P1,"^",5)]""
NEW PSOACBRK,PSOACBRV
Begin DoDot:2
+16 SET PSOACBRV=$PIECE(P1,"^",5)
+17 ;Use fileman for parsing
+18 KILL ^UTILITY($JOB,"W")
SET X="Comments: "_PSOACBRV
SET (DIWR,DIWL)=1
SET DIWF="C80"
DO ^DIWP
FOR I=1:1:^UTILITY($JOB,"W",1)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^UTILITY($JOB,"W",1,I,0))
End DoDot:2
+19 IF $PIECE($GET(^PSRX(DA,"A",N,1)),"^")]""
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",5)=$PIECE($GET(^PSRX(DA,"A",N,1)),"^")
IF $PIECE($GET(^PSRX(DA,"A",N,1)),"^",2)]""
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_":"_$PIECE($GET(^PSRX(DA,"A",N,1)),"^",2)
+20 IF $ORDER(^PSRX(DA,"A",N,2,0))
FOR I=0:0
SET I=$ORDER(^PSRX(DA,"A",N,2,I))
if 'I
QUIT
SET MIG=^PSRX(DA,"A",N,2,I,0)
Begin DoDot:2
+21 if MIG["Mail Tracking Info.
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",9)=" "
+22 FOR SG=1:1:$LENGTH(MIG)
if $LENGTH(^TMP("PSOAL",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",9)=" "
if $PIECE(MIG," ",SG)'=""
SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^TMP("PSOAL",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)
End DoDot:2
End DoDot:1
+23 KILL MIG,SG,I,^UTILITY($JOB,"W"),DIWF,DIWL,DIWR
+24 QUIT
+25 ;/BLB/ PSO*7.0*551 - END CHANGE
DAT SET DAT=""
SET DTT=DTT\1
if DTT'?7N
QUIT
SET DAT=$EXTRACT(DTT,4,5)_"/"_$EXTRACT(DTT,6,7)_"/"_$EXTRACT(DTT,2,3)
+1 QUIT
