RMPO190P.m

RMPO190P ;RGB/DEV - HO BILLING VIEW FIX PRE-INSTALL ;9/27/17  07:34

 ;;3.0;PROSTHETICS;**190**;Feb 09, 1996;Build 5

 Q

 ;RMPR*3.0*190  This pre-install routine will drive down through

 ;              the HO billing file (665.72) for each month in 

 ;              2017, beginning with April 2017.  The code will 

 ;              insure that every 660 pointer in the items billed 

 ;              has a valid date in the 660 entry for field #1, 

 ;              Request Date.  If null, the date will be populated

 ;              with the 15th of the month following the compiled 

 ;              month.

 ;

START K ^XTMP("RMPO190P")

 D NOW^%DTC S RMPOSTRT=%

 S ^XTMP("RMPO190P","START COMPILE")=RMPOSTRT

 S ^XTMP("RMPO190P","END COMPILE")="RUNNING"

 S ^XTMP("RMPO190P",0)=$$FMADD^XLFDT(RMPOSTRT,180)_"^"_RMPOSTRT

 S U="^",RMPOSIT=0,XXX=0

A S RMPOSIT=$O(^RMPO(665.72,RMPOSIT)),RMPODT=3170300 G AQ:'RMPOSIT

A1 S RMPODT=$O(^RMPO(665.72,RMPOSIT,1,RMPODT)),RMPOVND=0 G A:'RMPODT

 S RMPORQDT=($E(RMPODT,1,5)+1)_15 I $E(RMPORQDT,4,5)=13 S RMPORQDT=($E(RMPORQDT,1,3)+1)_"0115"

A2 S RMPOVND=$O(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND)),RMPOPAT=0 G A1:'RMPOVND

 I '$P(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,0),U,2) S $P(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,0),U,2)=RMPORQDT

A3 S RMPOPAT=$O(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT)),RMPOITM=0 G A2:'RMPOPAT

A4 S RMPOITM=$O(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT,1,RMPOITM)) G A3:'RMPOITM

 S RMPOBITM=^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT,1,RMPOITM,0)

 S RMPR660P=$P(RMPOBITM,U,16) I 'RMPR660P S ^XTMP("RMPO190P",2,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT,1,RMPOITM,0)=RMPOSIT_U_RMPODT_U_RMPOVND_U_RMPOPAT_U_RMPOITM G A4

 S RMPR660R=$G(^RMPR(660,RMPR660P,0)) I 'RMPR660R S ^XTMP("RMPO190P",3,RMPR660P,0)=RMPOSIT_U_RMPODT_U_RMPOVND_U_RMPOPAT_U_RMPOITM_U_RMPR660P G A4

 I $P(RMPR660R,U,3)="" D

 . S DA=RMPR660P,DIE="^RMPR(660,",DR="1////^S X=RMPORQDT" D ^DIE   ;SET 660 REC REQUEST DATE WITH NEXT MONTH RUN DATE

 . S ^XTMP("RMPO190P",1,RMPR660P,0)=^RMPR(660,RMPR660P,0)

 G A4

AQ K RMPOSIT,RMPODT,RMPOVND,RMPOPAT,RMPR660P,RMPR660R,RMPOSTRT,DA,DIE,DR,RMPOBITM,RMPOITM,RMPORQDT,%

 W !!,"<< PRE-INSTALL RUN COMPLETED, CORRECTING HO ITEMS WITH NULL 'REQUEST DATE' >>"

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPO190P   2279     printed  Apr 09, 2024@21:38:58                                                                                                                                                                                                    Page 2

RMPO190P  ;RGB/DEV - HO BILLING VIEW FIX PRE-INSTALL ;9/27/17  07:34

 +1       ;;3.0;PROSTHETICS;**190**;Feb 09, 1996;Build 5

 +2        QUIT 

 +3       ;RMPR*3.0*190  This pre-install routine will drive down through

 +4       ;              the HO billing file (665.72) for each month in 

 +5       ;              2017, beginning with April 2017.  The code will 

 +6       ;              insure that every 660 pointer in the items billed 

 +7       ;              has a valid date in the 660 entry for field #1, 

 +8       ;              Request Date.  If null, the date will be populated

 +9       ;              with the 15th of the month following the compiled 

 +10      ;              month.

 +11      ;

START      KILL ^XTMP("RMPO190P")

 +1        DO NOW^%DTC

           SET RMPOSTRT=%

 +2        SET ^XTMP("RMPO190P","START COMPILE")=RMPOSTRT

 +3        SET ^XTMP("RMPO190P","END COMPILE")="RUNNING"

 +4        SET ^XTMP("RMPO190P",0)=$$FMADD^XLFDT(RMPOSTRT,180)_"^"_RMPOSTRT

 +5        SET U="^"

           SET RMPOSIT=0

           SET XXX=0

A          SET RMPOSIT=$ORDER(^RMPO(665.72,RMPOSIT))

           SET RMPODT=3170300

           if 'RMPOSIT

               GOTO AQ

A1         SET RMPODT=$ORDER(^RMPO(665.72,RMPOSIT,1,RMPODT))

           SET RMPOVND=0

           if 'RMPODT

               GOTO A

 +1        SET RMPORQDT=($EXTRACT(RMPODT,1,5)+1)_15

           IF $EXTRACT(RMPORQDT,4,5)=13

               SET RMPORQDT=($EXTRACT(RMPORQDT,1,3)+1)_"0115"

A2         SET RMPOVND=$ORDER(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND))

           SET RMPOPAT=0

           if 'RMPOVND

               GOTO A1

 +1        IF '$PIECE(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,0),U,2)

               SET $PIECE(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,0),U,2)=RMPORQDT

A3         SET RMPOPAT=$ORDER(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT))

           SET RMPOITM=0

           if 'RMPOPAT

               GOTO A2

A4         SET RMPOITM=$ORDER(^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT,1,RMPOITM))

           if 'RMPOITM

               GOTO A3

 +1        SET RMPOBITM=^RMPO(665.72,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT,1,RMPOITM,0)

 +2        SET RMPR660P=$PIECE(RMPOBITM,U,16)

           IF 'RMPR660P

               SET ^XTMP("RMPO190P",2,RMPOSIT,1,RMPODT,1,RMPOVND,"V",RMPOPAT,1,RMPOITM,0)=RMPOSIT_U_RMPODT_U_RMPOVND_U_RMPOPAT_U_RMPOITM

               GOTO A4

 +3        SET RMPR660R=$GET(^RMPR(660,RMPR660P,0))

           IF 'RMPR660R

               SET ^XTMP("RMPO190P",3,RMPR660P,0)=RMPOSIT_U_RMPODT_U_RMPOVND_U_RMPOPAT_U_RMPOITM_U_RMPR660P

               GOTO A4

 +4        IF $PIECE(RMPR660R,U,3)=""

               Begin DoDot:1

 +5       ;SET 660 REC REQUEST DATE WITH NEXT MONTH RUN DATE

                   SET DA=RMPR660P

                   SET DIE="^RMPR(660,"

                   SET DR="1////^S X=RMPORQDT"

                   DO ^DIE

 +6                SET ^XTMP("RMPO190P",1,RMPR660P,0)=^RMPR(660,RMPR660P,0)

               End DoDot:1

 +7        GOTO A4

AQ         KILL RMPOSIT,RMPODT,RMPOVND,RMPOPAT,RMPR660P,RMPR660R,RMPOSTRT,DA,DIE,DR,RMPOBITM,RMPOITM,RMPORQDT,%

 +1        WRITE !!,"<< PRE-INSTALL RUN COMPLETED, CORRECTING HO ITEMS WITH NULL 'REQUEST DATE' >>"

 +2        QUIT