PSOORAL1 ;BHAM ISC/SAB - Build Listman activity logs ;04-Apr-2013 22:40;PLS
;;7.0;OUTPATIENT PHARMACY;**71,156,148,247,240,287,1015**;DEC 1997;Build 62
;
; Modified - IHS/MSC/PLS - 04/04/13 - Lines ACT+9 and ACT+11
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:8,1:7),DIR("A",1)=" ",DIR("A",2)="Select Activity Log by number",DIR("A",3)="1. Refill 2. Partial 3. Activity 4. Labels"
S DIR("A")=$S(CMOP:"5. Copay 6. ECME 7. CMOP Events 8. All Logs",1:"5. Copay 6. ECME 7. All Logs")
S DIR("B")=$S(CMOP:8,1:7) D ^DIR S PSOELSE=+Y I +Y S Y=$S(CMOP&(Y[8):"1,2,3,4,5,6,7",'CMOP&(Y[7):"1,2,3,4,5,6",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
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Routing: "_$S($P(RX0,"^",11)="W":"Window",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:"^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
;IHS/MSC/PLS - 04/04/13 - Added support for Reissue at line ACT+9 and +11
N CNT
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="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,"A",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Activity to report" Q
S CNT=0
F N=0:0 S N=$O(^PSRX(DA,"A",N)) Q:'N S P1=^(N,0),DTT=P1\1 D DAT D
.I $P(P1,"^",2)="M" Q
.S IEN=IEN+1,CNT=CNT+1,^TMP("PSOAL",$J,IEN,0)=CNT_" "_DAT_" ",$P(RN," ",15)=" ",REA=$P(P1,"^",2),REA=$F("HUCELPRWSIVDABXGKNZ",REA)-1
.I REA D
..S STA=$P("HOLD^UNHOLD^DISCONTINUED^EDIT^RENEWED^PARTIAL^REINSTATE^REPRINT^SUSPENSE^RETURNED^INTERVENTION^DELETED^DRUG INTERACTION^PROCESSED^X-INTERFACE^PATIENT INSTR.^PKI/DEA^DISP COMPLETED^REISSUE","^",REA)
..S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA_$E(RN,$L(STA)+1,15)
.E S $P(STA," ",15)=" ",^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&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),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)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(P1,"^",5)
.I $P(P1,"^",5)]"" N PSOACBRK,PSOACBRV D
..S PSOACBRV=$P(P1,"^",5)
..;PSO*7*240 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
..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
LBL ;label log
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 $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 ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$P($G(^VA(200,$P(LBL,"^",4),0)),"^"),IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(LBL,"^",3)
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 N,P1,RFT,PSOACBRK,PSOACBRV,MIG,SG,I,NOTFND,CNT,LINE
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",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)="="
S NOTFND=1,I=0 F S I=$O(^PSRX(DA,"A",I)) Q:'I S Z=$G(^PSRX(DA,"A",I,0)) I $P(Z,"^",2)="M" S NOTFND=0 Q
I NOTFND S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO ECME Activity to report" 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)'="M" Q
.S IEN=IEN+1,CNT=CNT+1
.K STA,RN S $P(RN," ",15)=" ",RF=+$P(P1,"^",4)
.S LINE=CNT,$E(LINE,5)=$$FMTE^XLFDT($P(P1,"^"),2),$E(LINE,25)=$S(RF:"REFILL "_RF,1:"ORIGINAL")
.S $E(LINE,41)=$$GET1^DIQ(200,+$P(P1,"^",3),.01)
.S ^TMP("PSOAL",$J,IEN,0)=LINE
.I $P(P1,"^",5)]"" D
..S PSOACBRV=$P(P1,"^",5)
..;PSO*7*240 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 $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
..F SG=1:1:$L(MIG) D
...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)
D DISPREJ
K ^UTILITY($J,"W"),DIWR,DIWF,DIWL
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:"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:$P(VAR,"^",14) $E(X,67)="(RE-OPENED)"
. 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
;
DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
Q
PSOORAL1 ;BHAM ISC/SAB - Build Listman activity logs ;04-Apr-2013 22:40;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**71,156,148,247,240,287,1015**;DEC 1997;Build 62
+2 ;
+3 ; Modified - IHS/MSC/PLS - 04/04/13 - Lines ACT+9 and ACT+11
+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:8,1:7)
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"
+6 SET DIR("A")=$SELECT(CMOP:"5. Copay 6. ECME 7. CMOP Events 8. All Logs",1:"5. Copay 6. ECME 7. All Logs")
+7 SET DIR("B")=$SELECT(CMOP:8,1:7)
DO ^DIR
SET PSOELSE=+Y
IF +Y
SET Y=$SELECT(CMOP&(Y[8):"1,2,3,4,5,6,7",'CMOP&(Y[7):"1,2,3,4,5,6",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 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Routing: "_$SELECT($PIECE(RX0,"^",11)="W":"Window",1:"Mail")_$SELECT($PIECE($GET(^PSRX(DA,"OR1")),"^",5):" Finished by: "_$PIECE(^VA(200,$PIECE(^PSRX(DA,"OR1"),"^",5),0),"^"),1:"")
+11 IF $GET(^PSRX(DA,"H"))]""&($PIECE(PSOLST(ORN),"^",3)="HOLD")
DO HLD^PSOORAL2
+12 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:"^PSORXVW2",1:"LBL")
End DoDot:1
+13 IF 'PSOELSE
SET VALMBCK=""
KILL PSOELSE
QUIT
+14 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
+15 KILL LBL,I,RFDATE,%H,%I,RN,RFT
+16 SET PSOAL=IEN
KILL IEN,ACT,LBL,LOG
DO EN^PSOORAL
SET VALMBCK="R"
+17 QUIT
ACT ;activity log
+1 ;IHS/MSC/PLS - 04/04/13 - Added support for Reissue at line ACT+9 and +11
+2 NEW CNT
+3 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Activity Log:"
+4 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)="="
+5 IF '$ORDER(^PSRX(DA,"A",0))
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There's NO Activity to report"
QUIT
+6 SET CNT=0
+7 FOR N=0:0
SET N=$ORDER(^PSRX(DA,"A",N))
IF 'N
QUIT
SET P1=^(N,0)
SET DTT=P1\1
DO DAT
Begin DoDot:1
+8 IF $PIECE(P1,"^",2)="M"
QUIT
+9 SET IEN=IEN+1
SET CNT=CNT+1
SET ^TMP("PSOAL",$JOB,IEN,0)=CNT_" "_DAT_" "
SET $PIECE(RN," ",15)=" "
SET REA=$PIECE(P1,"^",2)
SET REA=$FIND("HUCELPRWSIVDABXGKNZ",REA)-1
+10 IF REA
Begin DoDot:2
+11 SET STA=$PIECE("HOLD^UNHOLD^DISCONTINUED^EDIT^RENEWED^PARTIAL^REINSTATE^REPRINT^SUSPENSE^RETURNED^INTERVENTION^DELETED^DRUG INTERACTION^PROCESSED^X-INTERFACE^PATIENT INSTR.^PKI/DEA^DISP COMPLETED^REISSUE","^",REA)
+12 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA_$EXTRACT(RN,$LENGTH(STA)+1,15)
End DoDot:2
+13 IF '$TEST
SET $PIECE(STA," ",15)=" "
SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA
+14 KILL STA,RN
SET $PIECE(RN," ",15)=" "
SET RF=+$PIECE(P1,"^",4)
+15 SET RFT=$SELECT(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL")
+16 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))
+17 ;S:$P(P1,"^",5)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(P1,"^",5)
+18 IF $PIECE(P1,"^",5)]""
NEW PSOACBRK,PSOACBRV
Begin DoDot:2
+19 SET PSOACBRV=$PIECE(P1,"^",5)
+20 ;PSO*7*240 Use fileman for parsing
+21 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
+22 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)
+23 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
+24 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
+25 KILL MIG,SG,I,^UTILITY($JOB,"W"),DIWF,DIWL,DIWR
+26 QUIT
LBL ;label log
+1 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Label Log:"
+2 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)="="
+3 IF '$ORDER(^PSRX(DA,"L",0))
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Labels printed."
QUIT
+4 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
+5 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)
+6 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RFT_$PIECE($GET(^VA(200,$PIECE(LBL,"^",4),0)),"^")
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Comments: "_$PIECE(LBL,"^",3)
End DoDot:1
+7 QUIT
+8 ;
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 NEW N,P1,RFT,PSOACBRK,PSOACBRV,MIG,SG,I,NOTFND,CNT,LINE
+2 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="ECME Log:"
+3 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="# Date/Time Rx Ref Initiator Of Activity"
+4 SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
+5 SET NOTFND=1
SET I=0
FOR
SET I=$ORDER(^PSRX(DA,"A",I))
IF 'I
QUIT
SET Z=$GET(^PSRX(DA,"A",I,0))
IF $PIECE(Z,"^",2)="M"
SET NOTFND=0
QUIT
+6 IF NOTFND
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="There's NO ECME Activity to report"
QUIT
+7 SET CNT=0
+8 FOR N=0:0
SET N=$ORDER(^PSRX(DA,"A",N))
IF 'N
QUIT
SET P1=^(N,0)
Begin DoDot:1
+9 IF $PIECE(P1,"^",2)'="M"
QUIT
+10 SET IEN=IEN+1
SET CNT=CNT+1
+11 KILL STA,RN
SET $PIECE(RN," ",15)=" "
SET RF=+$PIECE(P1,"^",4)
+12 SET LINE=CNT
SET $EXTRACT(LINE,5)=$$FMTE^XLFDT($PIECE(P1,"^"),2)
SET $EXTRACT(LINE,25)=$SELECT(RF:"REFILL "_RF,1:"ORIGINAL")
+13 SET $EXTRACT(LINE,41)=$$GET1^DIQ(200,+$PIECE(P1,"^",3),.01)
+14 SET ^TMP("PSOAL",$JOB,IEN,0)=LINE
+15 IF $PIECE(P1,"^",5)]""
Begin DoDot:2
+16 SET PSOACBRV=$PIECE(P1,"^",5)
+17 ;PSO*7*240 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 $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
+20 FOR SG=1:1:$LENGTH(MIG)
Begin DoDot:3
+21 IF $LENGTH(^TMP("PSOAL",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",9)=" "
+22 IF $PIECE(MIG," ",SG)'=""
SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^TMP("PSOAL",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)
End DoDot:3
End DoDot:2
End DoDot:1
+23 DO DISPREJ
+24 KILL ^UTILITY($JOB,"W"),DIWR,DIWF,DIWL
+25 QUIT
+26 ;
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:"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 ; S:$P(VAR,"^",14) $E(X,67)="(RE-OPENED)"
+16 SET IEN=IEN+1
SET ^TMP(PRI,$JOB,IEN,0)=X
+17 IF $PIECE(VAR,"^",5)
Begin DoDot:2
+18 SET IEN=IEN+1
SET X=$$GET1^DIQ(52.25,REJ_","_DA,12)
+19 SET X1=$$GET1^DIQ(52.25,REJ_","_DA,13)
IF X1'=""
SET X=X1_" ("_X_")"
+20 FOR I=1:1
IF X=""
QUIT
Begin DoDot:3
+21 SET ^TMP(PRI,$JOB,IEN,0)=$SELECT(I=1:"Comments: ",1:" ")_$EXTRACT(X,1,69)
+22 SET X=$EXTRACT(X,70,999)
IF X'=""
SET IEN=IEN+1
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
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
