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 ---[H[J[2J[HRMPO190P 2279 printed Dec 13, 2024@02:30:44 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
