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

PSUOP2.m

Go to the documentation of this file.
  1. PSUOP2 ;BIR/CFL - PSU PBM Outpatient Pharmacy Data Collection for Version 7.0 ; 7/11/06 4:21pm
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;**6,8,9**;MARCH, 2005;Build 6
  1. ;
  1. ;DBIAs
  1. ; Reference to ^PSRX( file # 52 supported by DBIAs 465, 2512
  1. ; Reference to EN^PSOORDER supported by DBIA 1878
  1. ;
  1. ;
  1. EN ;Entry to data collection
  1. D ALLOOP,AMLOOP
  1. K ^TMP("PSOR",$J)
  1. Q
  1. ALLOOP ;Loop through the AL cross refererence
  1. N PSUDOC1,PSUCAN,PSUCL,PSUCMP,PSUFP,PSUORDT,PSUCO
  1. S PSUFDT=PSUSDT,PSUEDTM=PSUEDT_".24"
  1. F S PSUFDT=$O(^PSRX("AL",PSUFDT)) Q:PSUFDT=""!(PSUFDT>PSUEDTM) D
  1. .S PSURXIEN=""
  1. .F S PSURXIEN=$O(^PSRX("AL",PSUFDT,PSURXIEN)) Q:PSURXIEN="" D
  1. ..Q:$D(^XTMP(PSUOPSUB,"RXIEN",PSURXIEN)) ; already been processed
  1. ..Q:'$D(^PSRX(PSURXIEN,0)) ; watch out for dangling pointers
  1. ..S PSUCAN=$$GET1^DIQ(52,PSURXIEN,26.1,"I") ;Cancel date
  1. ..D GETS^PSUTL(52,PSURXIEN,"2;21;27","PSUOP","I")
  1. ..D MOVEI^PSUTL("PSUOP")
  1. ..S DFN=PSUOP(2)
  1. ..;
  1. ..Q:$$TESTPAT^PSUTL1(DFN)
  1. ..D PID^VADPT
  1. ..S PSUSSN=$TR(VA("PID"),"^-","")
  1. ..N PSUPSO S PSUPSO=1 ;flag to avoid a PSO error when SIG is too long
  1. ..D EN^PSOORDER(DFN,PSURXIEN)
  1. ..Q:'$D(^TMP("PSOR",$J))
  1. ..D EN^PSUOPAM ;Gather AMIS data
  1. ..D CMOPA ; set array of CMOP recs
  1. ..D NEW ; check ^TMP to see if New Rx is in time frame, if so create record.
  1. ..D REF ; check ^TMP to see if refills are in time frame, if so create records
  1. ..D PAR ; check ^TMP to see if partials are in time frame, if so create records
  1. Q
  1. ;
  1. AMLOOP ; loop through "AM", partials, cross reference to see if any were missed
  1. S X1=PSUSDT,X2=-1
  1. D C^%DTC K %,%H,%T
  1. S PSUFDT=PSUSDT,PSUEDTM=PSUEDT_".24"
  1. F S PSUFDT=$O(^PSRX("AM",PSUFDT)) Q:PSUFDT=""!(PSUFDT>PSUEDTM) D
  1. .S PSURXIEN=""
  1. .F S PSURXIEN=$O(^PSRX("AM",PSUFDT,PSURXIEN)) Q:PSURXIEN="" D
  1. ..Q:$D(^XTMP(PSUOPSUB,"RXIEN",PSURXIEN)) ; already been processed
  1. ..Q:'$D(^PSRX(PSURXIEN,0)) ; watch out for dangling pointers
  1. ..D GETS^PSUTL(52,PSURXIEN,"2;27","PSUOP","I")
  1. ..D MOVEI^PSUTL("PSUOP")
  1. ..S DFN=PSUOP(2)
  1. ..; SCREEN OUT TEST PATIENTS
  1. ..Q:$$TESTPAT^PSUTL1(DFN)
  1. ..D PID^VADPT
  1. ..S PSUSSN=$TR(VA("PID"),"^-","")
  1. ..D EN^PSOORDER(DFN,PSURXIEN)
  1. ..D EN^PSUOPAM ;Gather AMIS data PSU*4*5 fix
  1. ..D PAR ; check ^TMP to see if partials are in time frame, if so create records
  1. Q
  1. ;
  1. NEW ; New Rx
  1. S PSUFD=$P(^TMP("PSOR",$J,PSURXIEN,0),U,2)
  1. D COMVAR
  1. S PSUTYP="N"
  1. S PSUCMOP=$S($D(PSUCMA(0)):"Y",1:"N")
  1. S PSUR0=^TMP("PSOR",$J,PSURXIEN,0)
  1. S PSUORDT=$P(PSUR0,U,17) ;AMIS Original Login Date
  1. S PSUQTY=+$P(PSUR0,U,6)
  1. ;
  1. ;
  1. S PSUDS=$P(PSUR0,U,7)
  1. S PSUDRCT=$P(PSUR0,U,10)
  1. S PSURELDT=$P($P(PSUR0,U,13),".",1)
  1. Q:((PSURELDT<PSUSDT)!(PSURELDT>PSUEDTM))
  1. S PSUWPC=$E($P(PSUR0,U,15))
  1. NEWX1 ;I PSUCMOP="Y" Q:((PSURELDT="")!(PSURELDT<PSUSDT)!(PSURELDT>PSUEDTM))
  1. NEWX2 ;I PSUCMOP="N",((PSUFD<PSUSDT)!(PSUFD\1>PSUEDT)) Q
  1. S PSUR1=^TMP("PSOR",$J,PSURXIEN,1)
  1. ; MOVE NEXT 2 LINES TO COMMON VARIABLE AREA
  1. ;S PSUCLN=$P($P(PSUR1,U,4),";",2) ;AMIS data clinic
  1. ;S PSUFP=$P($P(PSUR1,U,9),";",1) ;AMIS finishing person
  1. S PSUPRID=$P($P(PSUR1,U,1),";",1)
  1. S PSURXP=$P($P(PSUR1,U,5),";",1)
  1. S PSUMW=$P($P(PSUR1,U,6),";",1)
  1. S PSUDIVP=$P(PSUR1,U,7)
  1. ;
  1. S PSUNDC=""
  1. I PSUCMOP="Y" S PSUNDC=PSUCMA(0)
  1. I PSUNDC="" S PSUNDC=$S($L(PSUOP(27)):PSUOP(27),$L(PSUDRUG(31)):PSUDRUG(31),1:"No NDC")
  1. D PROVDR^PSUOP3
  1. D SETREC^PSUOP3
  1. NEWQ Q
  1. ;
  1. REF ; Refills
  1. Q:'$D(^TMP("PSOR",$J,PSURXIEN,"REF"))
  1. D COMVAR
  1. S PSUFLN=""
  1. F S PSUFLN=$O(^TMP("PSOR",$J,PSURXIEN,"REF",PSUFLN)) Q:PSUFLN="" D
  1. .S PSUTYP="R"
  1. .S PSUCMOP=$S($D(PSUCMA(PSUFLN)):"Y",1:"N")
  1. .S PSUR0=^TMP("PSOR",$J,PSURXIEN,"REF",PSUFLN,0)
  1. .N PSUCLN,PSUR1
  1. .S PSUR1=^TMP("PSOR",$J,PSURXIEN,1)
  1. .S PSUCLN=$P($P(PSUR1,U,4),";",2)
  1. .S PSUWPC="N"
  1. .S PSUFD=$P(PSUR0,U,1)
  1. .S PSUPRID=$P($P(PSUR0,U,2),";",1)
  1. .S PSUQTY=+$P(PSUR0,U,4)
  1. .S PSUDS=$P(PSUR0,U,5)
  1. .S PSUDRCT=$P(PSUR0,U,6)
  1. .S PSURELDT=$P(PSUR0,U,8)
  1. .Q:((PSURELDT<PSUSDT)!(PSURELDT>PSUEDTM))
  1. .S PSUMW=$P($P(PSUR0,U,10),";",1)
  1. .S PSUDIVP=$P(PSUR0,U,11)
  1. .S PSUREDT=$P(PSUR0,U,12) ;AMIS Refill Login Date
  1. .I PSURELDT'="" S PSURELDT=PSURELDT\1
  1. .;I PSUCMOP="Y" Q:((PSURELDT="")!(PSURELDT<PSUSDT)!(PSURELDT>PSUEDTM))
  1. .;I PSUCMOP="N",((PSUFD<PSUSDT)!(PSUFD\1>PSUEDT)) Q
  1. .S PSUNDC=""
  1. .I PSUCMOP="Y" S PSUNDC=PSUCMA(PSUFLN)
  1. .I PSUNDC="" S PSUNDC=$$VALI^PSUTL(52.1,PSURXIEN,11)
  1. .I PSUNDC="" S PSUNDC=$S(PSUDRUG(31)'="":PSUDRUG(31),1:"No NDC")
  1. .;
  1. .D PROVDR^PSUOP3
  1. .D SETREC^PSUOP3
  1. REFQ Q
  1. ;
  1. PAR ; Partials
  1. Q:'$D(^TMP("PSOR",$J,PSURXIEN,"RPAR"))
  1. D COMVAR
  1. S PSUFLN=""
  1. F S PSUFLN=$O(^TMP("PSOR",$J,PSURXIEN,"RPAR",PSUFLN)) Q:PSUFLN="" D
  1. .S PSUR0=^TMP("PSOR",$J,PSURXIEN,"RPAR",PSUFLN,0)
  1. .N PSUCLN,PSUR1
  1. .S PSUR1=^TMP("PSOR",$J,PSURXIEN,1)
  1. .S PSUCLN=$P($P(PSUR1,U,4),";",2)
  1. .S PSUTYP="P"
  1. .S PSUCMOP="N"
  1. .S PSUWPC="N"
  1. .S PSUFD=$P(PSUR0,U,1)
  1. .;I (PSUFD<PSUSDT)!(PSUFD\1>PSUEDT) Q
  1. .S PSUPRID=$P($P(PSUR0,U,2),";",1)
  1. .S PSUQTY=+$P(PSUR0,U,4)
  1. .S PSUDS=$P(PSUR0,U,5)
  1. .S PSUDRCT=$P(PSUR0,U,6)
  1. .S PSURELDT=$P(PSUR0,U,8)
  1. .S PSUMW=$P($P(PSUR0,U,10),";",1)
  1. .S PSUDIVP=$P(PSUR0,U,11)
  1. .S PSUPDT=$P(PSUR0,U,12) ;AMIS Partial Login Date
  1. .I PSURELDT'="" S PSURELDT=PSURELDT\1
  1. .Q:((PSURELDT<PSUSDT)!(PSURELDT>PSUEDTM))
  1. .S PSUNDC=$$VALI^PSUTL(52.2,PSURXIEN,1)
  1. .I PSUNDC="" S PSUNDC=$S(PSUDRUG(31)'="":PSUDRUG(31),1:"No NDC")
  1. .;
  1. .D PROVDR^PSUOP3
  1. .D SETREC^PSUOP3
  1. PARQ Q
  1. ;
  1. COMVAR ; set variables that are common between all record types
  1. S PSUDR=$P($P(^TMP("PSOR",$J,PSURXIEN,"DRUG",0),U,1),";",1)
  1. ;S CMOPID=$P($G(^PSDRUG(PSUDR,"ND")),U,10) ;AMIS CMOP ID
  1. S PSUSIG=$P($G(^TMP("PSOR",$J,PSURXIEN,"SIG",1,0)),U,1)
  1. S PSURXP=$P($P(^TMP("PSOR",$J,PSURXIEN,1),U,5),";",1)
  1. S PSURXN=$P(^TMP("PSOR",$J,PSURXIEN,0),U,5)
  1. ; PSU*4*9 - INSERT NEXT 2 LINES
  1. S PSUCLN=$P($P(^TMP("PSOR",$J,PSURXIEN,1),U,4),";",2) ;AMIS CLINIC
  1. S PSUFP=$P($P(^TMP("PSOR",$J,PSURXIEN,1),U,9),";",1) ;FINISHING PERSON
  1. D GETDRUG^PSUOP3 ; loads data from file #50 using PSUDR as ien
  1. COMVARQ Q
  1. ;
  1. CMOPA ; set array of CMOP recs
  1. K PSUCMA
  1. N PSUR1,PSUX,PSUST,PSUFIL,PSUNDC
  1. S PSUX=""
  1. F S PSUX=$O(^TMP("PSOR",$J,PSURXIEN,"CMOP",PSUX)) Q:PSUX="" D
  1. .S PSUR1=^TMP("PSOR",$J,PSURXIEN,"CMOP",PSUX,0)
  1. .F X="PSUFIL^3","PSUST^4","PSUNDC^6" D PIECE(X,PSUR1,U)
  1. .S:+PSUST=1 PSUCMA(PSUFIL)=PSUNDC
  1. .K:+PSUST=3 PSUCMA(PSUFIL)
  1. .D:$D(PSUCMA(PSUFIL)) RTSTOCK
  1. CMOPAQ Q
  1. ;
  1. RTSTOCK ; test for "AR" if none then unmark CMOP
  1. ; needs PSURXIEN, PSUFIL, from CMOPA
  1. N PSURELDT,PSUR0,PSURTSDT
  1. I PSUFIL D Q
  1. . S PSUR0=$G(^TMP("PSOR",$J,PSURXIEN,"REF",PSUFIL,0))
  1. . F X="PSURELDT^8","PSURTSDT^9" D PIECE(X,PSUR0,U)
  1. . I PSURELDT,$D(^PSRX("AR",PSURELDT,PSURXIEN,PSUFIL)) Q
  1. . K PSUCMA(PSUFIL)
  1. ;
  1. S PSUR0=^TMP("PSOR",$J,PSURXIEN,0)
  1. F X="PSURELDT^13","PSURTSDT^14" D PIECE(X,PSUR0,U)
  1. I PSURELDT,$D(^PSRX("AR",PSURELDT,PSURXIEN,PSUFIL)) Q
  1. I $D(PSUCMA(PSUFIL)) K PSUCMA(PSUFIL)
  1. Q
  1. PIECE(%,REC,DLM) ;Piece % from record REC using delimiter DLM
  1. ; %="VARNAME^PIECE",REC=SOURCE,DLM=DELIMITER in REC
  1. N Y,I S Y=$P(%,U,1),I=$P(%,U,2) S @Y=$P(REC,DLM,I)
  1. Q
  1. ;