Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOORAL1

PSOORAL1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. 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))
  1. 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"
  1. 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")
  1. 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
  1. .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
  1. .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
  1. .;441 PAPI
  1. .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:"")
  1. .D:$G(^PSRX(DA,"H"))]""&($P(PSOLST(ORN),"^",3)="HOLD") HLD^PSOORAL2
  1. .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")
  1. I 'PSOELSE S VALMBCK="" K PSOELSE Q
  1. 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
  1. K LBL,I,RFDATE,%H,%I,RN,RFT
  1. S PSOAL=IEN K IEN,ACT,LBL,LOG D EN^PSOORAL S VALMBCK="R"
  1. Q
  1. ACT ;activity log
  1. D ACT^PSOORAL3
  1. Q
  1. ;
  1. LBL ;label log
  1. N PSORDATA,PSONAME,X,PSOX
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Label Log:"
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date Rx Ref Printed By",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
  1. I '$O(^PSRX(DA,"L",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Labels printed." Q
  1. 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
  1. . S PSORDATA=""
  1. . 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)
  1. . S PSORDATA=$$LBLDATA^PSOORAL3(DA,LBL)
  1. . K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(LBL,"^",4) D ^DIC
  1. . 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))
  1. . 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))
  1. . I $P(PSORDATA,U)]"" S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "_$P(PSORDATA,U)
  1. . N FDAMGDOC S FDAMGDOC=$G(^PSRX(DA,"L",L1,"FDA"))
  1. . I FDAMGDOC'="" D
  1. . . S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="FDA Med Guide: "_$E(FDAMGDOC,1,61)
  1. . . I $L(FDAMGDOC)>61 D
  1. . . . F Q:$E(FDAMGDOC,62,999)="" D
  1. . . . . S FDAMGDOC=$E(FDAMGDOC,62,999),IEN=IEN+1
  1. . . . . S ^TMP("PSOAL",$J,IEN,0)=$E(FDAMGDOC,1,61)
  1. Q
  1. ;
  1. COPAY ;Copay activity log
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Copay Activity Log:"
  1. 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)="="
  1. I '$O(^PSRX(DA,"COPAY",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Copay activity to report" Q
  1. F N=0:0 S N=$O(^PSRX(DA,"COPAY",N)) Q:'N S P1=^(N,0),DTT=P1\1 D DAT D
  1. .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" ",$P(RN," ",21)=" ",REA=$P(P1,"^",2),REA=$F("ARICE",REA)-1
  1. .I REA D
  1. ..S STA=$P("ANNUAL CAP REACHED^COPAY RESET^IB-INITIATED COPAY^REMOVE COPAY CHARGE^RX EDITED^","^",REA)
  1. ..S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA_$E(RN,$L(STA)+1,21)
  1. .E S $P(STA," ",21)=" ",^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA
  1. .K STA,RN S $P(RN," ",15)=" ",RF=+$P(P1,"^",4)
  1. .S RFT=$S(RF>0:"REFILL "_RF,1:"ORIGINAL")
  1. .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))
  1. .S:$P(P1,"^",5)]""!($P(P1,"^",6)]"")!($P(P1,"^",7)]"") IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comment: "_$P(P1,"^",5)
  1. .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)
  1. Q
  1. ;
  1. ECME ; ECME activity log
  1. ;
  1. N DIWF,DIWL,DIWR,I,II,III,LINE,PSOAR,PSOCNT,PSOCNT1,PSOCOMMENT
  1. N PSODATA,PSODATE,PSODATE1,PSOFIELDS,PSOFILE,PSOIENS,PSOLINE
  1. N PSOREFILL,PSOREFILL1,PSOUSER,PSOUSER1
  1. ;
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="ECME Log:"
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date/Time Rx Ref Initiator Of Activity"
  1. S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
  1. ;
  1. ; The comments from ACTIVITY LOG (#52.3) and REJECT INFO (#52.25)
  1. ; will be compiled in array PSOAR. This array will allow comments
  1. ; from each sub-file to be sorted in ascending order by date.
  1. ; A counter (PSOCNT) will be used to accommodate multiple
  1. ; comments with the exact same date/time.
  1. ;
  1. ; PSOAR array definition:
  1. ;
  1. ; PSOAR(PSODATE)=PSOCNT
  1. ; PSOAR(PSODATE,PSOCNT)=PSODATE^PSOUSER1^PSOREFILL1^PSOCOMMENT
  1. ; PSOAR(PSODATE,PSOCNT,PSOCNT1)=Additional Comments (if any)
  1. ;
  1. ; PSODATE ---- Date/time of comment - internal format
  1. ; PSOCNT ----- Counter of comments, by date
  1. ; PSOCNT1 ---- Counter of additional comments (if any)
  1. ; PSOUSER1 --- User who entered comment - external format
  1. ; PSOREFILL1 - Refill number - external format
  1. ; PSOCOMMENT - Comment
  1. ;
  1. ; Kill PSOAR to initialize array
  1. ;
  1. K PSOAR
  1. ;
  1. ; Loop through ACTIVITY LOG (file #52.3) searching for ECME Entries.
  1. ; ECME Entries are defined as REASON="M".
  1. ;
  1. ; ACTIVITY LOG Fields:
  1. ; .01 = Activity Log (Date)
  1. ; .02 = Reason
  1. ; .03 = Initiator of Activity (User)
  1. ; .04 = RX Reference (Refill #)
  1. ; .05 = Comment
  1. ;
  1. ; The above fields will be stored in array PSODATA via a call to ^DIQ.
  1. ;
  1. S I=0
  1. F S I=$O(^PSRX(DA,"A",I)) Q:'I D
  1. . ;
  1. . S PSOCNT=0
  1. . S PSOFILE=52.3
  1. . S PSOIENS=I_","_DA_","
  1. . S PSOFIELDS=".01;.02;.03;.04;.05"
  1. . K PSODATA
  1. . ;
  1. . D GETS^DIQ(PSOFILE,I_","_DA,PSOFIELDS,"IE","PSODATA")
  1. . ;
  1. . ; If reason is not M (ECME), do not include comment.
  1. . ;
  1. . I $G(PSODATA(PSOFILE,PSOIENS,.02,"I"))'="M" Q
  1. . ;
  1. . S PSODATE=$G(PSODATA(PSOFILE,PSOIENS,.01,"I"))
  1. . S PSOUSER1=$G(PSODATA(PSOFILE,PSOIENS,.03,"E"))
  1. . S PSOREFILL1=$S('$G(PSODATA(PSOFILE,PSOIENS,.04,"I")):"ORIGINAL",1:"REFILL "_PSODATA(PSOFILE,PSOIENS,.04,"I"))
  1. . S PSOCOMMENT=$G(PSODATA(PSOFILE,PSOIENS,.05,"I"))
  1. . ;
  1. . S PSOCNT=$G(PSOAR(PSODATE))+1
  1. . S PSOAR(PSODATE)=PSOCNT
  1. . S PSOAR(PSODATE,PSOCNT)=$$FMTE^XLFDT(PSODATE,2)_U_PSOUSER1_U_PSOREFILL1_U_PSOCOMMENT
  1. . ;
  1. . ; Node 2 of the ACTIVITY LOG contains any additional comments.
  1. . ; Loop through OTHER COMMENTS sub-file (file #52.34) to add to PSOAR
  1. . ; for reporting.
  1. . ;
  1. . I $D(^PSRX(DA,"A",I,2)) D
  1. . . S PSOCNT1=0
  1. . . S II=0
  1. . . F S II=$O(^PSRX(DA,"A",I,2,II)) Q:'II D
  1. . . . S PSOCNT1=PSOCNT1+1
  1. . . . S PSOAR(PSODATE,PSOCNT,PSOCNT1)=$$GET1^DIQ(52.34,II_","_I_","_DA,.01)
  1. ;
  1. ; Loop through REJECT INFO Comments (File #52.2551) searching for
  1. ; User Created entries.
  1. ; User Created entries are defined as User'="POSTMASTER"
  1. ;
  1. ; REJECT INFO Comments Fields:
  1. ; .01 = Date/Time
  1. ; 1 = User
  1. ; 2 = Comments
  1. ;
  1. ; The above fields will be stored in array PSODATA via a call to ^DIQ.
  1. ;
  1. 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
  1. . S III=0 F S III=$O(^PSRX(DA,"REJ",I,"COM","B",PSODATE,III)) Q:'III D
  1. . . S REC=$G(^PSRX(DA,"REJ",I,"COM",III,0))
  1. . . S PSOUSER=$P(REC,U,2),PSOUSER1=$P($G(^VA(200,PSOUSER,0)),U,1)
  1. . . S PSOCOMMENT=$P(REC,U,3)
  1. . . ;
  1. . . S PSOREFILL=$$GET1^DIQ(52.25,I_","_DA,5)
  1. . . I PSOREFILL=0 S PSOREFILL1="ORIGINAL"
  1. . . E S PSOREFILL1="REFILL #"_PSOREFILL
  1. . . ;
  1. . . S PSOCNT=$G(PSOAR(PSODATE))+1
  1. . . S PSOAR(PSODATE)=PSOCNT
  1. . . S PSOAR(PSODATE,PSOCNT)=$$FMTE^XLFDT(PSODATE,2)_U_PSOUSER1_U_PSOREFILL1_U_PSOCOMMENT
  1. ;
  1. ; If PSOAR array contains no data, there is No ECME Activity to report.
  1. ;
  1. I '$D(PSOAR) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO ECME Activity to report" Q
  1. ;
  1. ; Loop through PSOAR array and assign data to ^TMP array for reporting.
  1. ;
  1. ; PSOLINE = ECME Log Entry line number.
  1. ;
  1. S (PSODATE1,PSOREFILL,PSOUSER)=""
  1. S PSODATE="" F S PSODATE=$O(PSOAR(PSODATE)) Q:PSODATE="" D
  1. . S PSOCNT="" F S PSOCNT=$O(PSOAR(PSODATE,PSOCNT)) Q:PSOCNT="" D
  1. . . S PSODATA=$G(PSOAR(PSODATE,PSOCNT))
  1. . . ;
  1. . . S IEN=IEN+1
  1. . . I '$D(PSOLINE) S PSOLINE=0
  1. . . S PSOLINE=PSOLINE+1
  1. . . S PSODATE1=$P(PSODATA,U)
  1. . . S PSOUSER=$P(PSODATA,U,2)
  1. . . S PSOREFILL=$P(PSODATA,U,3)
  1. . . S LINE=PSOLINE
  1. . . S $E(LINE,5)=PSODATE1
  1. . . S $E(LINE,25)=PSOREFILL
  1. . . S $E(LINE,41)=PSOUSER
  1. . . S ^TMP("PSOAL",$J,IEN,0)=LINE
  1. . . ;
  1. . . ; D ^DIWP formats comments into ^UTILITY($J,"W")
  1. . . ;
  1. . . S PSOCOMMENT=$P(PSODATA,"^",4)
  1. . . ;
  1. . . K ^UTILITY($J,"W")
  1. . . ;
  1. . . S X="Comments: "_PSOCOMMENT
  1. . . S (DIWR,DIWL)=1,DIWF="C80"
  1. . . D ^DIWP
  1. . . ;
  1. . . ; Additional comments (if any)
  1. . . ;
  1. . . S PSOCNT1=""
  1. . . F S PSOCNT1=$O(PSOAR(PSODATE,PSOCNT,PSOCNT1)) Q:PSOCNT1="" D
  1. . . . S X=PSOAR(PSODATE,PSOCNT,PSOCNT1)
  1. . . . S DIWF="C80I10"
  1. . . . D ^DIWP
  1. . . ;
  1. . . ; Loop through ^UTILITY($J,"W"), adding comments to ^TMP
  1. . . ;
  1. . . F I=1:1:^UTILITY($J,"W",1) D
  1. . . . S IEN=IEN+1
  1. . . . S ^TMP("PSOAL",$J,IEN,0)=$G(^UTILITY($J,"W",1,I,0))
  1. ;
  1. D DISPREJ
  1. ;
  1. K ^UTILITY($J,"W"),DIWR,DIWF,DIWL
  1. Q
  1. ;
  1. SPMP ; SPMP (State Prescription Monitoring Program) Log
  1. N FILL,BAT,LOG,BAT0,LOG0
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1
  1. S ^TMP("PSOAL",$J,IEN,0)="SPMP (State Prescription Monitoring Program) Log:"
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Date/Time Fill Type Exp. Type Bat# Filename"
  1. S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",80)="="
  1. I '$D(^PS(58.42,"ARX",DA)) D Q
  1. . S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Export Log for this prescription."
  1. S FILL=""
  1. F S FILL=$O(^PS(58.42,"ARX",DA,FILL)) Q:FILL="" D
  1. . S BAT=0 F S BAT=$O(^PS(58.42,"ARX",DA,FILL,BAT)) Q:'BAT D
  1. . . S LOG=0 F S LOG=$O(^PS(58.42,"ARX",DA,FILL,BAT,LOG)) Q:'LOG D
  1. . . . S BAT0=$G(^PS(58.42,BAT,0)),LOG0=$G(^PS(58.42,BAT,"RX",LOG,0))
  1. . . . I '$P(BAT0,"^",10) Q
  1. . . . S IEN=IEN+1,LINE=$$FMTE^XLFDT($P(BAT0,"^",10),2),$E(LINE,17)=$J($P(LOG0,"^",2),4)
  1. . . . S $E(LINE,22)=$$GET1^DIQ(58.42001,LOG_","_BAT,2),$E(LINE,29)=$$GET1^DIQ(58.42,BAT,2)
  1. . . . S $E(LINE,39)=BAT,$E(LINE,45)=$E($$GET1^DIQ(58.42,BAT,6),1,35)
  1. . . . S ^TMP("PSOAL",$J,IEN,0)=LINE
  1. Q
  1. ;
  1. DISPREJ ;
  1. N LN,SEQ,REJ,PRI,VAR,X,X1,X2,I,RFT
  1. I '$D(^PSRX(DA,"REJ")) Q
  1. S PRI="PSOAL",$P(LN,"=",80)="",SEQ=0
  1. S IEN=$G(IEN)+1,^TMP(PRI,$J,IEN,0)=" "
  1. S IEN=IEN+1,^TMP(PRI,$J,IEN,0)="ECME REJECT Log:"
  1. S IEN=IEN+1,^TMP(PRI,$J,IEN,0)="# Date/Time Rcvd Rx Ref Reject Type STATUS Date/Time Resolved"
  1. S IEN=IEN+1,^TMP(PRI,$J,IEN,0)=LN
  1. F REJ=0:0 S REJ=$O(^PSRX(DA,"REJ",REJ)) Q:'REJ D
  1. . S VAR=$G(^PSRX(DA,"REJ",REJ,0))
  1. . S RFT=+$P(VAR,"^",4)
  1. . S SEQ=SEQ+1,X=SEQ,$E(X,4)=$$FMTE^XLFDT($P(VAR,"^",2),2),$E(X,22)=$S(RFT:"REFILL "_RFT,1:"ORIGINAL")
  1. . 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.
  1. . S $E(X,48)=$S($P(VAR,"^",5):"RESOLVED",1:"UNRESOLVED")
  1. . S:$P(VAR,"^",6) $E(X,59)=$$FMTE^XLFDT($P(VAR,"^",6),2)
  1. . S IEN=IEN+1,^TMP(PRI,$J,IEN,0)=X
  1. . I $P(VAR,"^",5) D
  1. . . S IEN=IEN+1,X=$$GET1^DIQ(52.25,REJ_","_DA,12)
  1. . . S X1=$$GET1^DIQ(52.25,REJ_","_DA,13) S:X1'="" X=X1_" ("_X_")"
  1. . . F I=1:1 Q:X="" D
  1. . . . S ^TMP(PRI,$J,IEN,0)=$S(I=1:"Comments: ",1:" ")_$E(X,1,69)
  1. . . . S X=$E(X,70,999) S:X'="" IEN=IEN+1
  1. Q
  1. ;
  1. ERX ; eRx Log
  1. ;/BLB/ PSO*7.0*551 - BEGIN CHANGE - ERX LOG
  1. N CNT,G,STR,X,I,TMP,N,ERXREC,ERXCHK,DAT,PSOACBRV,P1
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="eRx Activity Log:"
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date Reason Rx Ref Initiator Of Activity"
  1. S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",80)="="
  1. S ERXCHK=0 F S ERXCHK=$O(^PSRX(DA,"A",ERXCHK)) Q:'ERXCHK D
  1. .I $P(^PSRX(DA,"A",ERXCHK,0),U,2)="O" S ERXREC=1
  1. I '$G(ERXREC) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are no eRx activity logs." Q
  1. S CNT=0
  1. F N=0:0 S N=$O(^PSRX(DA,"A",N)) Q:'N S P1=^(N,0) D
  1. .I $P(P1,"^",2)'="O" Q
  1. .S DAT=$$FMTE^XLFDT($P(P1,"^"),2)_" "
  1. .S IEN=IEN+1,CNT=CNT+1,^TMP("PSOAL",$J,IEN,0)=CNT_" "_$E(DAT,1,21),$P(RN," ",15)=" ",REA=$P(P1,"^",2)
  1. .I $P(P1,"^",5)]"" N PSOACBRK,PSOACBRV D
  1. ..S PSOACBRV=$P(P1,"^",5)
  1. ..;Use fileman for parsing
  1. ..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))
  1. .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)
  1. .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
  1. ..S:MIG["Mail Tracking Info.: " IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" "
  1. ..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)
  1. K MIG,SG,I,^UTILITY($J,"W"),DIWF,DIWL,DIWR
  1. Q
  1. ;/BLB/ PSO*7.0*551 - END CHANGE
  1. DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
  1. Q