PSXRTN.m

PSXRTN ;BIR/WPB,PWC-Queue for the Background Filer at Host Facilities ;MAR 1,2002@16:11:17

 ;;2.0;CMOP;**32,44**;11 Apr 97

QUE W !!

 I $D(^PSX(554,"AB")) S DIR(0)="Y",DIR("A",1)="This job is already scheduled.",DIR("A")="Do you want to unschedule this job",DIR("B")="NO" D ^DIR K DIR G:Y<1!($D(DIRUT)) EXIT G:Y=1 STOPJOB^PSXBKD Q

 S %DT="AEXR",%DT("A")="Enter starting date/time:  ",%DT("B")="NOW" D ^%DT K %DT G:Y<0!($D(DTOUT)) EXIT S PSXDATE=Y K Y,X

 S ZTDTH=PSXDATE,ZTDESC="CMOP Background Filer CMOP Master Database file",ZTIO="",ZTRTN="DATA^PSXRTN1",ZTSAVE("DUZ")="" D ^%ZTLOAD

 I $G(ZTSK)>0 W !,"Job Started.",! D

 .K DD,DO

 .S:'$D(^PSX(554,1,1,0)) ^PSX(554,1,1,0)="^554.01SA^^"

 .S DA(1)=1,X=1,DIC(0)="Z",DIC="^PSX(554,"_DA(1)_",1,",DIC("DR")="1////"_PSXDATE_";2////"_ZTSK_";3////S;4////"_DUZ D FILE^DICN K DIC,DIC(0),DIC("DR"),X

 S ZTREQ="@"

 Q

NEXT S FREQ="900S",ZTSK=PSXZTSK,ZTRTN="DATA^PSXRTN1",ZTIO="",ZTDESC="CMOP Automated Release Data Processor",ZTDTH=FREQ D REQ^%ZTLOAD

 ;D ISQED^%ZTLOAD S:$G(ZTSK(0))=0!($G(ZTSK(0))=1) NXTM=$$HTFM^XLFDT($G(ZTSK("D")))

 D NOW^%DTC

 S RE=$O(^PSX(554,"AB","")) S:$G(RE)>0 $P(^PSX(554,1,1,RE,0),"^",9)=%

 K ZTDESC,ZTRTN,ZTSK,ZTIO,ZTDTH,FREQ,ZTSAVE("DUZ"),ZTREQ,PSXZTSK,RE,%

EXIT K AF,BB,CC,CNT,COMDT,DIE,DIC,DR,DA,DRUG,EMPID,FILL,I,NPTR,NREC,PSXFM,PSXNDC,PSXTS,QRYID,QTY,REASON,RECDT,REL,RXN,RXSTAT,SNODE,SS,STAT,REL1,DUPFLG,CANFLG,CDT1,RX1,SP,SP2,SP3,XX1,XX2

 K TNODE,UU,VV,X,XPTR,XREC,XX,XXX,Y,DEL,IEN50,N,NK,NNREC,PSXDATE,COST,STDATE,TIME,XDA,QRYN,ACKTM,ACKT,%,TDT,CANFLG,STOP,LST,LSTQRY,CANF,IDDRG,COST,IEN50,DIROUT,DIR,DIRUT,DTOUT,DUOUT,CDT,LCNT,NXTM

 Q

NDRGMSG Q:'$D(^TMP($J,"PSXNDG"))

 I $$GET1^DIQ(554,1,8)="NO" Q

 S XMSUB="CMOP DRUG Cost Missing",XMDUZ=.5,XMDUN="CMOP Manager"

 D XMZ^XMA2 G:XMZ'>0 NDRGMSG

 S XX2="********************"

 S LCNT=1,^XMB(3.9,XMZ,2,LCNT,0)="DRUG/Items listed below are missing cost data or are not marked for CMOP.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1,XX1="                  "

 S ^XMB(3.9,XMZ,2,LCNT,0)="DRUG ID  COMPLETED DATE    RX NUMBER         TRANSMISSION",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="-------------------------------------------------------------------------------",LCNT=LCNT+1

 S IDRG="" F  S IDRG=$O(^TMP($J,"PSXNDG",IDRG)) Q:IDRG=""  S CDT="" F  S CDT=$O(^TMP($J,"PSXNDG",IDRG,CDT)) Q:CDT=""  D

 .S CDT1=$$FMTE^XLFDT(CDT,"2D"),RX1=$P(^TMP($J,"PSXNDG",IDRG,CDT),"^",1),SP="    ",SP2=$E(XX1,1,18-$L(CDT1)),SP3=$E(XX1,1,18-$L(RX1))

 .S ^XMB(3.9,XMZ,2,LCNT,0)=IDRG_SP_CDT1_SP2_RX1_SP3_$P(^TMP($J,"PSXNDG",IDRG,CDT),"^",2),LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$E(XX2,1,$L(XX2)-1),LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="There is NO ENTRY in DRUG file #50 marked for CMOP Dispense with this ID number",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="and/or there is no COST information available.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$E(XX2,1,$L(XX2)-1),LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="Corrective Action:  ",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 1:  Locate the correct entry in DRUG file #50, or create the new entry",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="             if necessary.  Since the drug/item was filled by the automated",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="             system, you can look up the VA Print Name on that system, not",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="             DHCP, to determine what the DRUG file #50 entry should be.  The",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="             remainder of the steps should be done on DHCP.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 2:  Be sure the entry is marked for Outpatient use.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 3:  Match to the correct NATIONAL DRUG file entry.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 4:  Verify the match.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 5:  Merge the NDF data into DRUG file #50.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 6:  Enter the correct cost information in DRUG file #50.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 7:  Run the Cost Update option for the completed date listed to",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="             update the CMOP MASTER DATABASE file.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 8:  Review prescriptions listed above using the Rx Inquiry option",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="             to validate that the cost entry is complete.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="    Step 9:  Recompile the cost data for the date(s) listed to pick up the new",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="             cost data.",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$E(XX2,1,$L(XX2)-1),LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)="** Failure to complete these changes will result in inaccurate cost reports. **",LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$E(XX2,1,$L(XX2)-1),LCNT=LCNT+1

 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT

 K XMY D GRP^PSXNOTE D ENT1^XMD

 G EXIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSXRTN   5135     printed  Mar 13, 2025@20:49:42                                                                                                                                                                                                      Page 2

PSXRTN    ;BIR/WPB,PWC-Queue for the Background Filer at Host Facilities ;MAR 1,2002@16:11:17

 +1       ;;2.0;CMOP;**32,44**;11 Apr 97

QUE        WRITE !!

 +1        IF $DATA(^PSX(554,"AB"))

               SET DIR(0)="Y"

               SET DIR("A",1)="This job is already scheduled."

               SET DIR("A")="Do you want to unschedule this job"

               SET DIR("B")="NO"

               DO ^DIR

               KILL DIR

               if Y<1!($DATA(DIRUT))

                   GOTO EXIT

               if Y=1

                   GOTO STOPJOB^PSXBKD

               QUIT 

 +2        SET %DT="AEXR"

           SET %DT("A")="Enter starting date/time:  "

           SET %DT("B")="NOW"

           DO ^%DT

           KILL %DT

           if Y<0!($DATA(DTOUT))

               GOTO EXIT

           SET PSXDATE=Y

           KILL Y,X

 +3        SET ZTDTH=PSXDATE

           SET ZTDESC="CMOP Background Filer CMOP Master Database file"

           SET ZTIO=""

           SET ZTRTN="DATA^PSXRTN1"

           SET ZTSAVE("DUZ")=""

           DO ^%ZTLOAD

 +4        IF $GET(ZTSK)>0

               WRITE !,"Job Started.",!

               Begin DoDot:1

 +5                KILL DD,DO

 +6                if '$DATA(^PSX(554,1,1,0))

                       SET ^PSX(554,1,1,0)="^554.01SA^^"

 +7                SET DA(1)=1

                   SET X=1

                   SET DIC(0)="Z"

                   SET DIC="^PSX(554,"_DA(1)_",1,"

                   SET DIC("DR")="1////"_PSXDATE_";2////"_ZTSK_";3////S;4////"_DUZ

                   DO FILE^DICN

                   KILL DIC,DIC(0),DIC("DR"),X

               End DoDot:1

 +8        SET ZTREQ="@"

 +9        QUIT 

NEXT       SET FREQ="900S"

           SET ZTSK=PSXZTSK

           SET ZTRTN="DATA^PSXRTN1"

           SET ZTIO=""

           SET ZTDESC="CMOP Automated Release Data Processor"

           SET ZTDTH=FREQ

           DO REQ^%ZTLOAD

 +1       ;D ISQED^%ZTLOAD S:$G(ZTSK(0))=0!($G(ZTSK(0))=1) NXTM=$$HTFM^XLFDT($G(ZTSK("D")))

 +2        DO NOW^%DTC

 +3        SET RE=$ORDER(^PSX(554,"AB",""))

           if $GET(RE)>0

               SET $PIECE(^PSX(554,1,1,RE,0),"^",9)=%

 +4        KILL ZTDESC,ZTRTN,ZTSK,ZTIO,ZTDTH,FREQ,ZTSAVE("DUZ"),ZTREQ,PSXZTSK,RE,%

EXIT       KILL AF,BB,CC,CNT,COMDT,DIE,DIC,DR,DA,DRUG,EMPID,FILL,I,NPTR,NREC,PSXFM,PSXNDC,PSXTS,QRYID,QTY,REASON,RECDT,REL,RXN,RXSTAT,SNODE,SS,STAT,REL1,DUPFLG,CANFLG,CDT1,RX1,SP,SP2,SP3,XX1,XX2

 +1        KILL TNODE,UU,VV,X,XPTR,XREC,XX,XXX,Y,DEL,IEN50,N,NK,NNREC,PSXDATE,COST,STDATE,TIME,XDA,QRYN,ACKTM,ACKT,%,TDT,CANFLG,STOP,LST,LSTQRY,CANF,IDDRG,COST,IEN50,DIROUT,DIR,DIRUT,DTOUT,DUOUT,CDT,LCNT,NXTM

 +2        QUIT 

NDRGMSG    if '$DATA(^TMP($JOB,"PSXNDG"))

               QUIT 

 +1        IF $$GET1^DIQ(554,1,8)="NO"

               QUIT 

 +2        SET XMSUB="CMOP DRUG Cost Missing"

           SET XMDUZ=.5

           SET XMDUN="CMOP Manager"

 +3        DO XMZ^XMA2

           if XMZ'>0

               GOTO NDRGMSG

 +4        SET XX2="********************"

 +5        SET LCNT=1

           SET ^XMB(3.9,XMZ,2,LCNT,0)="DRUG/Items listed below are missing cost data or are not marked for CMOP."

           SET LCNT=LCNT+1

 +6        SET ^XMB(3.9,XMZ,2,LCNT,0)=""

           SET LCNT=LCNT+1

           SET XX1="                  "

 +7        SET ^XMB(3.9,XMZ,2,LCNT,0)="DRUG ID  COMPLETED DATE    RX NUMBER         TRANSMISSION"

           SET LCNT=LCNT+1

 +8        SET ^XMB(3.9,XMZ,2,LCNT,0)="-------------------------------------------------------------------------------"

           SET LCNT=LCNT+1

 +9        SET IDRG=""

           FOR 

               SET IDRG=$ORDER(^TMP($JOB,"PSXNDG",IDRG))

               if IDRG=""

                   QUIT 

               SET CDT=""

               FOR 

                   SET CDT=$ORDER(^TMP($JOB,"PSXNDG",IDRG,CDT))

                   if CDT=""

                       QUIT 

                   Begin DoDot:1

 +10                   SET CDT1=$$FMTE^XLFDT(CDT,"2D")

                       SET RX1=$PIECE(^TMP($JOB,"PSXNDG",IDRG,CDT),"^",1)

                       SET SP="    "

                       SET SP2=$EXTRACT(XX1,1,18-$LENGTH(CDT1))

                       SET SP3=$EXTRACT(XX1,1,18-$LENGTH(RX1))

 +11                   SET ^XMB(3.9,XMZ,2,LCNT,0)=IDRG_SP_CDT1_SP2_RX1_SP3_$PIECE(^TMP($JOB,"PSXNDG",IDRG,CDT),"^",2)

                       SET LCNT=LCNT+1

                   End DoDot:1

 +12       SET ^XMB(3.9,XMZ,2,LCNT,0)=""

           SET LCNT=LCNT+1

 +13       SET ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$EXTRACT(XX2,1,$LENGTH(XX2)-1)

           SET LCNT=LCNT+1

 +14       SET ^XMB(3.9,XMZ,2,LCNT,0)="There is NO ENTRY in DRUG file #50 marked for CMOP Dispense with this ID number"

           SET LCNT=LCNT+1

 +15       SET ^XMB(3.9,XMZ,2,LCNT,0)="and/or there is no COST information available."

           SET LCNT=LCNT+1

 +16       SET ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$EXTRACT(XX2,1,$LENGTH(XX2)-1)

           SET LCNT=LCNT+1

 +17       SET ^XMB(3.9,XMZ,2,LCNT,0)=""

           SET LCNT=LCNT+1

 +18       SET ^XMB(3.9,XMZ,2,LCNT,0)="Corrective Action:  "

           SET LCNT=LCNT+1

 +19       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 1:  Locate the correct entry in DRUG file #50, or create the new entry"

           SET LCNT=LCNT+1

 +20       SET ^XMB(3.9,XMZ,2,LCNT,0)="             if necessary.  Since the drug/item was filled by the automated"

           SET LCNT=LCNT+1

 +21       SET ^XMB(3.9,XMZ,2,LCNT,0)="             system, you can look up the VA Print Name on that system, not"

           SET LCNT=LCNT+1

 +22       SET ^XMB(3.9,XMZ,2,LCNT,0)="             DHCP, to determine what the DRUG file #50 entry should be.  The"

           SET LCNT=LCNT+1

 +23       SET ^XMB(3.9,XMZ,2,LCNT,0)="             remainder of the steps should be done on DHCP."

           SET LCNT=LCNT+1

 +24       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 2:  Be sure the entry is marked for Outpatient use."

           SET LCNT=LCNT+1

 +25       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 3:  Match to the correct NATIONAL DRUG file entry."

           SET LCNT=LCNT+1

 +26       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 4:  Verify the match."

           SET LCNT=LCNT+1

 +27       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 5:  Merge the NDF data into DRUG file #50."

           SET LCNT=LCNT+1

 +28       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 6:  Enter the correct cost information in DRUG file #50."

           SET LCNT=LCNT+1

 +29       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 7:  Run the Cost Update option for the completed date listed to"

           SET LCNT=LCNT+1

 +30       SET ^XMB(3.9,XMZ,2,LCNT,0)="             update the CMOP MASTER DATABASE file."

           SET LCNT=LCNT+1

 +31       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 8:  Review prescriptions listed above using the Rx Inquiry option"

           SET LCNT=LCNT+1

 +32       SET ^XMB(3.9,XMZ,2,LCNT,0)="             to validate that the cost entry is complete."

           SET LCNT=LCNT+1

 +33       SET ^XMB(3.9,XMZ,2,LCNT,0)="    Step 9:  Recompile the cost data for the date(s) listed to pick up the new"

           SET LCNT=LCNT+1

 +34       SET ^XMB(3.9,XMZ,2,LCNT,0)="             cost data."

           SET LCNT=LCNT+1

 +35       SET ^XMB(3.9,XMZ,2,LCNT,0)=""

           SET LCNT=LCNT+1

 +36       SET ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$EXTRACT(XX2,1,$LENGTH(XX2)-1)

           SET LCNT=LCNT+1

 +37       SET ^XMB(3.9,XMZ,2,LCNT,0)="** Failure to complete these changes will result in inaccurate cost reports. **"

           SET LCNT=LCNT+1

 +38       SET ^XMB(3.9,XMZ,2,LCNT,0)=XX2_XX2_XX2_$EXTRACT(XX2,1,$LENGTH(XX2)-1)

           SET LCNT=LCNT+1

 +39       SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT

 +40       KILL XMY

           DO GRP^PSXNOTE

           DO ENT1^XMD

 +41       GOTO EXIT