- 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 Feb 18, 2025@23:58:08 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