source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFET85.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1RMPFET85 ;DDC/KAW-CONTINUATION OF RMPFET84 [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3CERT ;;Set Custom Hearing Aid Order Certification
4 ;; input: RMPFX,RMPFY,RMPFHAT,MD,BX
5 ;;output: None
6 S S0=$G(^RMPF(791810,RMPFX,101,RMPFY,0)),RMPFSTO=$P(S0,U,18)
7 I RMPFSTO,$D(^RMPF(791810.2,RMPFSTO,0)) S RMPFSTO=$P(^(0),U,2)
8 S IT=$P(S0,U,1) I IT,$D(^RMPF(791811,IT,0)) S IT=$P(^(0),U,1)
9C1 G C12:BX=1
10 W !!,"Certify line item ",MD," (",IT,")","? YES// " D READ
11 G CERTE:$D(RMPFOUT)
12C11 I $D(RMPFQUT) W !!,"Enter a <Y> or <RETURN> to certify the line item",!?5,"an <N> to exit." G C1
13 S:Y="" Y="Y" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G C11
14 G CERTE:"Nn"[Y
15C12 I RMPFSTO="E"!(RMPFSTO="D") D CLEAR^RMPFET61 G CERTE:'$D(RMPFSTO)
16 S X="NOW",%DT="T" D ^%DT S TD=Y
17 S AP=$P(S0,U,20) I 'AP S LA="R" G C2
18 S LA=$P(S0,U,19) I LA="" S LA="R" G C2
19 S LA=$S(LA="O":"R",LA'["R":LA_"R",AP&(LA["R"):LA,1:"R")
20C2 S DIE="^RMPF(791810,"_RMPFX_",101,",DA(1)=RMPFX,DA=RMPFY
21 S DR=".05" D ^DIE I $P(^RMPF(791810,RMPFX,101,RMPFY,0),U,5)="" W !!,"*** SERIAL NUMBER REQUIRED FOR A CERTIFICATION ***" H 1 G CERTE
22 S DR=".17////"_TD_";.19////"_LA_";.2////1"
23 I $P($G(^RMPF(791810,RMPFX,101,RMPFY,90)),U,8) S DR=DR_";90.1////"_DUZ_";90.11////"_TD
24 E S DR=DR_";90.08////"_DUZ_";90.09////"_TD
25 D ^DIE
26 I DR'[90.1 G CERTE:'$P($G(^RMPF(791810,RMPFX,101,RMPFY,90)),U,8)
27 E G CERTE:'$P($G(^RMPF(791810,RMPFX,101,RMPFY,90)),U,10)
28 I RMPFHAT="I" S DR=".18///ISSUE DATE PENDING" D ^DIE
29 W !!,"*** Order " W:$P($G(^RMPF(791810,RMPFX,101,RMPFY,90)),U,10) "Re-" W "Certified ***" H 1
30 W ! S DIE="^RMPF(791810,",DA=RMPFX,DR=10.01 D ^DIE
31CERTE K S0,%DT,D0,DA,DI,DQ,DIC,IT,X,Y,DIE,DR,TD,AP,LA,RMPFBT,RMPFSTO Q
32READ K RMPFOUT,RMPFQUT
33 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
34 I Y?1"^".E S (RMPFOUT,Y)="" Q
35 S:Y?1"?".E (RMPFQUT,Y)=""
36 Q
Note: See TracBrowser for help on using the repository browser.