RMPR4E23 ;HINES CIOFO/TH - PROMPT FOR SHIPMENT DATE ;08/05/03
;;3.0;PROSTHETICS;**78,114,118**;Feb 09, 1996
;
;TH 08/05/03 Patch #78 - Add shipment date.
; - DBIA #3427
;
; RMIFCAP = IFCAP Order
; RMPRTRDT = Transaction Date from file #440.6
; RMPRSHIP = Shipment Date
;
S (RMIFCAP,RMPRTRDT,RMPRSHIP)=""
; Set default to today's date
S RMPRTRDT=DT
I $D(^RMPR(664,RMPRA)) D
. Q:'$D(^RMPR(664,RMPRA,4))
. S RMIFCAP=$P(^RMPR(664,RMPRA,4),U,6) Q:RMIFCAP=""
. I $D(^PRCH(440.6,"PO",RMIFCAP)) D
. . S D1="",D1=$O(^PRCH(440.6,"PO",RMIFCAP,D1),-1) Q:D1=""
. . Q:'$D(^PRCH(440.6,D1,0))
. . S RMPRTRDT=$$GET1^DIQ(440.6,D1,6,"I")
S RMPRTRDT=$$FMTE^XLFDT(RMPRTRDT,"2D")
D GETDT,BILL,EXIT
Q
;
GETDT ; DIR call to obtain the shipment date
Q:$G(DA)=""
I $G(SKPSHDT)=1 D G GETDT1 ;SKPSHDT set in RMPR4E21 to auto set ship date to trans date
. S RMPRSHIP=DT
. I RMPRTRDT'="" S X=RMPRTRDT K %DT D ^%DT S RMPRSHIP=Y
K DIR,DIRUT
S DIR(0)="D",DIR("A")="Shipment Date",DIR("B")=$G(RMPRTRDT)
S DIR("?")="The date that the item shipped to the patient. The default"
S DIR("?")=DIR("?")_" date would be the transaction date from IFCAP."
D ^DIR
S RMPRSHIP=Y
GETDT1 G:'$D(^RMPR(660,DA)) EXIT
G:RMPRSHIP="" EXIT
; Shipment Date/Date of Service filed in file #660.
I DA'="" S $P(^RMPR(660,DA,1),U,8)=RMPRSHIP
Q
;
BILL ; File to #660.5 - ready to bill
Q ; taken out for phase II Billing Aware (WLC 02/26/04)
N DIC,X,DLAYGO,DIR
S DIC="^RMPR(660.5,"
S DIC(0)="L",X="""N"""
S DLAYGO=660.5 D ^DIC K DLAYGO Q:Y<1
S RMPRO=+Y,DIE=DIC
;
L +^RMPR(660.5,RMPRO)
; .01-Transaction Date; 2-Send Required; .02-Shipment Date
; 3-ProsFile(pointer to file #660)
S DR=".01////^S X=DT;2////1;.02////^S X=RMPRSHIP;3////^S X=DA"
D ^DIE
L -^RMPR(660.5,RMPRO)
Q
;
EXIT ; Exit
K DA,DIC,DIE,DR,RMIFCAP,RMPRTRDT,RMPRSHIP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR4E23 1905 printed Dec 13, 2024@02:32:46 Page 2
RMPR4E23 ;HINES CIOFO/TH - PROMPT FOR SHIPMENT DATE ;08/05/03
+1 ;;3.0;PROSTHETICS;**78,114,118**;Feb 09, 1996
+2 ;
+3 ;TH 08/05/03 Patch #78 - Add shipment date.
+4 ; - DBIA #3427
+5 ;
+6 ; RMIFCAP = IFCAP Order
+7 ; RMPRTRDT = Transaction Date from file #440.6
+8 ; RMPRSHIP = Shipment Date
+9 ;
+10 SET (RMIFCAP,RMPRTRDT,RMPRSHIP)=""
+11 ; Set default to today's date
+12 SET RMPRTRDT=DT
+13 IF $DATA(^RMPR(664,RMPRA))
Begin DoDot:1
+14 if '$DATA(^RMPR(664,RMPRA,4))
QUIT
+15 SET RMIFCAP=$PIECE(^RMPR(664,RMPRA,4),U,6)
if RMIFCAP=""
QUIT
+16 IF $DATA(^PRCH(440.6,"PO",RMIFCAP))
Begin DoDot:2
+17 SET D1=""
SET D1=$ORDER(^PRCH(440.6,"PO",RMIFCAP,D1),-1)
if D1=""
QUIT
+18 if '$DATA(^PRCH(440.6,D1,0))
QUIT
+19 SET RMPRTRDT=$$GET1^DIQ(440.6,D1,6,"I")
End DoDot:2
End DoDot:1
+20 SET RMPRTRDT=$$FMTE^XLFDT(RMPRTRDT,"2D")
+21 DO GETDT
DO BILL
DO EXIT
+22 QUIT
+23 ;
GETDT ; DIR call to obtain the shipment date
+1 if $GET(DA)=""
QUIT
+2 ;SKPSHDT set in RMPR4E21 to auto set ship date to trans date
IF $GET(SKPSHDT)=1
Begin DoDot:1
+3 SET RMPRSHIP=DT
+4 IF RMPRTRDT'=""
SET X=RMPRTRDT
KILL %DT
DO ^%DT
SET RMPRSHIP=Y
End DoDot:1
GOTO GETDT1
+5 KILL DIR,DIRUT
+6 SET DIR(0)="D"
SET DIR("A")="Shipment Date"
SET DIR("B")=$GET(RMPRTRDT)
+7 SET DIR("?")="The date that the item shipped to the patient. The default"
+8 SET DIR("?")=DIR("?")_" date would be the transaction date from IFCAP."
+9 DO ^DIR
+10 SET RMPRSHIP=Y
GETDT1 if '$DATA(^RMPR(660,DA))
GOTO EXIT
+1 if RMPRSHIP=""
GOTO EXIT
+2 ; Shipment Date/Date of Service filed in file #660.
+3 IF DA'=""
SET $PIECE(^RMPR(660,DA,1),U,8)=RMPRSHIP
+4 QUIT
+5 ;
BILL ; File to #660.5 - ready to bill
+1 ; taken out for phase II Billing Aware (WLC 02/26/04)
QUIT
+2 NEW DIC,X,DLAYGO,DIR
+3 SET DIC="^RMPR(660.5,"
+4 SET DIC(0)="L"
SET X="""N"""
+5 SET DLAYGO=660.5
DO ^DIC
KILL DLAYGO
if Y<1
QUIT
+6 SET RMPRO=+Y
SET DIE=DIC
+7 ;
+8 LOCK +^RMPR(660.5,RMPRO)
+9 ; .01-Transaction Date; 2-Send Required; .02-Shipment Date
+10 ; 3-ProsFile(pointer to file #660)
+11 SET DR=".01////^S X=DT;2////1;.02////^S X=RMPRSHIP;3////^S X=DA"
+12 DO ^DIE
+13 LOCK -^RMPR(660.5,RMPRO)
+14 QUIT
+15 ;
EXIT ; Exit
+1 KILL DA,DIC,DIE,DR,RMIFCAP,RMPRTRDT,RMPRSHIP
+2 QUIT
