RMPOPED1 ;EDS/MDB,DDW,RVD - HOME OXYGEN MISC FILE EDITS CONT. ;7/24/98
;;3.0;PROSTHETICS;**168**;Feb 09, 1996;Build 43
;
RMPRWARN(RMPRICD,RMPRACS,RMPODFN,ITEM,RMPRCONT) ;
; Display Inactive ICD code warning.
W !!,"This item contains the ICD Diagnosis Code: ",RMPRICD," which was inactive based"
W !,"on the start date of the currently selected prescription."
W !!,"You may 1) select a different item with no ICD code or with an active ICD code,"
W !," 2) enter a new item or "
W !," 3) proceed with this item. If you proceed with this item, the existing"
W !," ICD Diagnosis code ",RMPRICD," will be DELETED."
W !!,"You may then enter an active ICD-",RMPRACS," Diagnosis code or you may leave"
W !,"the ICD Diagnosis field blank."
; Prompt user to continue or not
S RMPRCONT=$$CONTINUE()
; User does want to continue so delete ICD code from currently selected Item
I RMPRCONT=1 D DLTITEM(RMPODFN,ITEM) Q
; User doesn't want to continue
S ITEM=""
Q
;
CONTINUE() ;
; prompt user to continue w/ current Item after warning was issued
N DIR
S DIR("A")="Do you wish to continue? ",DIR(0)="YA"
W !
D ^DIR
W !
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q -1
; User quits - back to Item Prompt
I Y<1 Q -1
Q 1
;
DLTITEM(RMPODFN,ITEM) ;
; Delete Inactive ICD code from Item
S DA(1)=RMPODFN,DA=ITEM
S DIE="^RMPR(665,"_DA(1)_",""RMPOC"","
S DR="7///@"
D ^DIE
Q
Q
; End of RMPOPED1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOPED1 1468 printed Dec 13, 2024@02:31:17 Page 2
RMPOPED1 ;EDS/MDB,DDW,RVD - HOME OXYGEN MISC FILE EDITS CONT. ;7/24/98
+1 ;;3.0;PROSTHETICS;**168**;Feb 09, 1996;Build 43
+2 ;
RMPRWARN(RMPRICD,RMPRACS,RMPODFN,ITEM,RMPRCONT) ;
+1 ; Display Inactive ICD code warning.
+2 WRITE !!,"This item contains the ICD Diagnosis Code: ",RMPRICD," which was inactive based"
+3 WRITE !,"on the start date of the currently selected prescription."
+4 WRITE !!,"You may 1) select a different item with no ICD code or with an active ICD code,"
+5 WRITE !," 2) enter a new item or "
+6 WRITE !," 3) proceed with this item. If you proceed with this item, the existing"
+7 WRITE !," ICD Diagnosis code ",RMPRICD," will be DELETED."
+8 WRITE !!,"You may then enter an active ICD-",RMPRACS," Diagnosis code or you may leave"
+9 WRITE !,"the ICD Diagnosis field blank."
+10 ; Prompt user to continue or not
+11 SET RMPRCONT=$$CONTINUE()
+12 ; User does want to continue so delete ICD code from currently selected Item
+13 IF RMPRCONT=1
DO DLTITEM(RMPODFN,ITEM)
QUIT
+14 ; User doesn't want to continue
+15 SET ITEM=""
+16 QUIT
+17 ;
CONTINUE() ;
+1 ; prompt user to continue w/ current Item after warning was issued
+2 NEW DIR
+3 SET DIR("A")="Do you wish to continue? "
SET DIR(0)="YA"
+4 WRITE !
+5 DO ^DIR
+6 WRITE !
+7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT -1
+8 ; User quits - back to Item Prompt
+9 IF Y<1
QUIT -1
+10 QUIT 1
+11 ;
DLTITEM(RMPODFN,ITEM) ;
+1 ; Delete Inactive ICD code from Item
+2 SET DA(1)=RMPODFN
SET DA=ITEM
+3 SET DIE="^RMPR(665,"_DA(1)_",""RMPOC"","
+4 SET DR="7///@"
+5 DO ^DIE
+6 QUIT
+7 QUIT
+8 ; End of RMPOPED1
