95 lines
5.1 KiB
Mathematica
95 lines
5.1 KiB
Mathematica
RMPFET8 ;DDC/KAW-ADJUST AN ORDER [ 06/16/95 3:06 PM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**17**;06/06/01
|
|
;;input : RMPFX,DFN,RMPFTYP,RMPFHAT,RMPFTP
|
|
;;output: None
|
|
Q:'$D(RMPFX) Q:'$D(DFN) Q:'DFN
|
|
W @IOF,!!,"ORDER ADJUSTMENTS"
|
|
W !!?32,"*** WARNING ***"
|
|
W !!,"This module is used to make adjustments to an order that has already been"
|
|
W !!,"sent to the DDC. Orders may be adjusted up to 60 working days after aids"
|
|
W !!,"are issued. If an adjustment is made after issue, the DDC will update the"
|
|
W !!,"the order with the status 'CERTIFICATION PENDING'. Certification will again"
|
|
W !!,"be required before the vendor will be paid."
|
|
D CONT^RMPFET G END:$D(RMPFOUT)
|
|
EN1 S S0=^RMPF(791810,RMPFX,0) K RMPFADJ
|
|
I RMPFTYP,$D(^RMPF(791810.1,RMPFTYP,0)) S RMPFTYPP=$P(^(0),U,1)
|
|
I RMPFTYP=""!(RMPFHAT="") W $C(7),!!,"ERROR IN ORDER TYPE" G END
|
|
K RMPFSEL1
|
|
EDIT D PAT^RMPFUTL,HEAD,^RMPFDT2
|
|
S (X,CT)=0 F I=1:1 S X=$O(RMPFO(X)) Q:'X S CT=CT+1
|
|
D SEL G END:$D(RMPFOUT),EDIT:$D(RMPFQUT),END:RMPFSEL1="",EDIT
|
|
END K RMPFTYPP,CT,X,RMPFOUT,RMPFQUT,RMPFSEL1,RMPFADJ,RMPFDOD
|
|
K RMPFDOB,RMPFNAM,RMPFMD,RMPFO,RMPFSSN,CM,CX,DI,DIC,I,Y,RMPFRE Q
|
|
SEL ;;Select adjustment action
|
|
;; input: RMPFX,CT,RMPFMD
|
|
;;output: RMPFSEL1
|
|
S RMPFODAT=$P(^RMPF(791810,RMPFX,0),"^",9)
|
|
I RMPFODAT>3010630 D
|
|
.W !!!,"Enter <C>hange Model, <H>istory or <RETURN> to continue: " D READ
|
|
I RMPFODAT<3010701 D
|
|
.W !!!,"Enter <C>hange Model, <R>emove Component, <A>dd Component,"
|
|
.W " <H>istory or <RETURN> to continue: " D READ
|
|
G SELE:$D(RMPFOUT)
|
|
SEL1 I $D(RMPFQUT) D MSG G SELE:$D(RMPFOUT) S RMPFQUT="" G SELE
|
|
S RMPFSEL1=$E(Y,1) G SELE:RMPFSEL1=""
|
|
I RMPFODAT>3010630 I "CcHh"'[RMPFSEL1 S RMPFQUT="" G SEL1
|
|
I RMPFODAT<3010701 I "CcRrAaHh"'[RMPFSEL1 S RMPFQUT="" G SEL1
|
|
I "Hh"[RMPFSEL1 D ^RMPFDT7 G SELE
|
|
I CT=1,$P(^RMPF(791810,RMPFX,101,RMPFMD(1),0),U,15)'="C" S RMPFY=RMPFMD(1) G DO
|
|
NUM S Z=$E(Y,2,99) G ITEM:'Z
|
|
I $D(RMPFMD(Z)),$P(^RMPF(791810,RMPFX,101,RMPFMD(Z),0),U,15)'="C" S RMPFY=RMPFMD(Z) G DO
|
|
ITEM W !!,"Select number of item to adjust: " D READ G SELE:$D(RMPFOUT)
|
|
ITEM1 I $D(RMPFQUT) W !!,"Enter the number to the left of the item that you wish to adjust." G ITEM
|
|
G SELE:Y="" I '$D(RMPFMD(Y)) S RMPFQUT="" G ITEM1
|
|
S RMPFY=RMPFMD(Y)
|
|
I $P(^RMPF(791810,RMPFX,101,RMPFY,0),U,15)="C" W $C(7),!!,"*** THIS ORDER HAS BEEN CANCELED ***" S RMPFQUT="" G ITEM1
|
|
DO S X=$P(^RMPF(791810,RMPFX,101,RMPFY,0),U,18) G SELE:'X,SELE:'$D(^RMPF(791810.2,X,0)) S X=$P(^(0),U,2) G SELE:X="" I "SECF"'[X W !!,$C(7),"*** LINE ITEMS WITH THIS STATUS CANNOT BE ADJUSTED ***" H 2 G SELE
|
|
I "Cc"[RMPFSEL1 D CHANGEM^RMPFET81 G END:$D(RMPFOUT)!'$D(RMPFY) D CERTIFY G END:$D(RMPFOUT),SELE
|
|
I RMPFODAT<3010701 I "Rr"[RMPFSEL1 D REMOVEC^RMPFET81 G END:$D(RMPFOUT)!'$D(RMPFY) D CERTIFY G END:$D(RMPFOUT),SELE
|
|
I RMPFODAT<3010701 I "Aa"[RMPFSEL1 D ADDC^RMPFET81 G END:$D(RMPFOUT)!'$D(RMPFY) D CERTIFY G END:$D(RMPFOUT),SELE
|
|
SELE K X,Y,Z,RMPFMD,RMPFY Q
|
|
READ K RMPFOUT,RMPFQUT
|
|
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|
I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|
S:Y?1"?".E (RMPFQUT,Y)=""
|
|
Q
|
|
HEAD W @IOF,!?27,"ACTIVE ORDER INFORMATION"
|
|
W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|
W !,"Patient: ",$E(RMPFNAM,1,25),?40,"SSN: ",RMPFSSN,?62,"DOB: ",RMPFDOB
|
|
W ! F I=1:1:80 W "-"
|
|
Q
|
|
CERTIFY S S0=^RMPF(791810,RMPFX,101,RMPFY,0)
|
|
Q:'$P(S0,U,20) Q:$P(S0,U,19)'["A"
|
|
Q:'$D(^RMPF(791810,RMPFX,101,RMPFY,90)) F I=8:1:11 S $P(^(90),U,I)=""
|
|
W !!,"*** THIS LINE ITEM MUST BE CERTIFIED ***"
|
|
S BX=1 D ^RMPFET85
|
|
Q
|
|
MSG W !!,"Enter <C> to change a hearing aid model"
|
|
W:RMPFODAT<3010701 !?6,"<R> to remove a component from the order"
|
|
W:RMPFODAT<3010701 !?6,"<A> to add a component to the order"
|
|
W !?6,"<H> to view the history of the order actions"
|
|
W !?6,"<RETURN> to continue."
|
|
W !!,"If the order consists of more than one model, the number of the model needing to",!,"be adjusted may be entered after the letter from the command line (i.g., 'C2')."
|
|
W !!,"Enter <RETURN> to continue." D READ Q
|
|
DELETE ;;Delete old model when changing models
|
|
;; input: RMPFX,RMPFY,RMPFRE,RMPFMSG,RMPFY1
|
|
;;output: None
|
|
S S0=^RMPF(791810,RMPFX,101,RMPFY1,0),IT=$P(S0,U,1)
|
|
S LR=$P(S0,U,4),CX=$P(S0,U,14),X="NOW",%DT="T" D ^%DT S TD=Y
|
|
S DIC="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX,DLAYGO=791810
|
|
S DIC(0)="L",X=""_IT_""
|
|
S DIC("DR")=".04////"_LR_";.14////"_CX_";.15////DC;.16////"_RMPFY1_";.18///APPROVED;90.01////"_DUZ_";90.02////"_TD_";90.03////"_RMPFRE_";90.04////"_RMPFMESG W "."
|
|
K DD,DO D FILE^DICN S RMPFY3=+Y
|
|
I Y=-1 W $C(7),!!,"*** MODEL NOT DELETED ***" H 2 Q
|
|
S RMPFY=RMPFY1 D ARRAY2^RMPFDT2
|
|
S RMPFZ=0 F IX=1:1 S RMPFZ=$O(RMPFC(RMPFZ)) Q:'RMPFZ W "." D
|
|
.S IT=$P(RMPFC(RMPFZ),U,1),CX=$P(RMPFC(RMPFZ),U,2)
|
|
.I '$D(^RMPF(791810,RMPFX,101,RMPFY3,102,0)) S ^RMPF(791810,RMPFX,101,RMPFY3,102,0)="^791810.101102P"
|
|
.S DIC="^RMPF(791810,"_RMPFX_",101,"_RMPFY3_",102,",X=""_IT_""
|
|
.S DA(2)=RMPFX,DA(1)=RMPFY3,DLAYGO=791810,DIC(0)="L"
|
|
.S DIC("DR")=".03////D;.05////"_DUZ_";.06////"_TD_";.07////"_RMPFRE
|
|
.K DO,DD D FILE^DICN I Y=-1 W $C(7),!!,"*** COMPONENT NOT DELETED ***" Q
|
|
.S $P(^RMPF(791810,RMPFX,101,RMPFY3,102,+Y,0),U,4)=+Y,$P(^(0),U,2)=CX Q
|
|
K X,Y,RMPFOUT,RMPFQUT,DIC,RMPFZ,RMPFC,IT,CX,DA,ZZ,ZY,RMPFRE,RMPFY3,TD
|
|
K LR,IX,%,%DT,D0,DI,DIE,DLAYGO,DQ,DR Q
|