RMPOPED1.m

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 ---RMPOPED1   1468     printed  Feb 18, 2025@23:57:46                                                                                                                                                                                                    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