| [613] | 1 | PRCNCMR ;SSI/ALA-CMR Official ;[ 03/13/97 10:29 AM ]
|
|---|
| 2 | ;;1.0;PRCN;**3,14**;Sep 13, 1996
|
|---|
| 3 | REV ; Review equipment requests
|
|---|
| 4 | S PRCNC=DUZ D CMR K PRCNC
|
|---|
| 5 | S DIC="^PRCN(413,",DIC(0)="AEQZ"
|
|---|
| 6 | S DIC("S")="S ST=$P(^(0),U,7),CMRZ=$P(^(0),U,16) I ((ST=3)!(ST=5)!(ST=45))&($D(PRCNCMR(CMRZ)))"
|
|---|
| 7 | D ^DIC G EXIT:Y<0 K DIC("S")
|
|---|
| 8 | S (IN,DA)=+Y,PRCNUSR=0,DIE=413 D SETUP^PRCNPRNT
|
|---|
| 9 | S PRCNST=$P(^PRCN(413,IN,0),U,7)
|
|---|
| 10 | I PRCNST'=45 S DR="[PRCNCMR]"
|
|---|
| 11 | I PRCNST=45 S DR="75"
|
|---|
| 12 | D ^DIE I PRCNST=45 D G REV
|
|---|
| 13 | . I $P(^PRCN(413,DA,2),U,17)="Y" S DR="6////^S X=39;7////^S X=DT"
|
|---|
| 14 | . I $P(^PRCN(413,DA,2),U,17)="N" S DR="6////^S X=4;7////^S X=DT;77////^S X=45"
|
|---|
| 15 | . D ^DIE,EXIT
|
|---|
| 16 | I $P(^PRCN(413,IN,0),U,9)="R" D
|
|---|
| 17 | . ; If replacment request copy CMR fields into turnin request
|
|---|
| 18 | . S DA=$P(^PRCN(413,IN,0),U,11)
|
|---|
| 19 | . S CPRV=$P($G(^PRCN(413,IN,2)),U,16),$P(^PRCN(413.1,DA,0),U,10)=CPRV
|
|---|
| 20 | . F I=1:1:$P($G(^PRCN(413,IN,15,0)),U,4) S ^PRCN(413.1,DA,2,I,0)=$G(^PRCN(413,IN,15,I,0))
|
|---|
| 21 | . S ^PRCN(413.1,DA,2,0)="^^"_I_U_I_DT_U
|
|---|
| 22 | . I CPRV="Y" S DIE=413.1,DR="6////^S X=6;7////^S X=DT" D ^DIE
|
|---|
| 23 | . I CPRV="N" S DIE=413.1,DR="6////^S X=4;7////^S X=DT" D ^DIE
|
|---|
| 24 | D EXIT
|
|---|
| 25 | G REV
|
|---|
| 26 | EXIT K DA,DIC,DIE,DR,I,IN,PRCNUSR,PRCNCMR,PRCN,CPRV,ST,PRCNST,PRCNTY,STA,D
|
|---|
| 27 | K %,C,D0,J,GLO,FAIL,PRCNDEF,LPRI,OLDPRI,PRIMAX,SERV,CMRZ,JJ
|
|---|
| 28 | Q
|
|---|
| 29 | MES ; Send mail message when CMR Official has not approved request
|
|---|
| 30 | S XMB(1)=$P(^PRCN(413,DA,0),U),XMB="PRCNCMR1",XMDUZ=DUZ,XMY(XMDUZ)=""
|
|---|
| 31 | S XMY($P(^PRCN(413,DA,0),U,2))=""
|
|---|
| 32 | S CMRDA=$P(^PRCN(413,DA,0),U,16)
|
|---|
| 33 | I CMRDA'="",$D(^ENG(6914.1,CMRDA,0)),($P(^ENG(6914.1,CMRDA,0),U,2)'="") S XMY($P(^ENG(6914.1,CMRDA,0),U,2))=""
|
|---|
| 34 | ; Append the explanation text
|
|---|
| 35 | S NL=$P($G(^PRCN(413,DA,15,0)),U,3),XMTEXT="MSG("
|
|---|
| 36 | I NL'="" F I=1:1:NL S MSG(I)=$G(^PRCN(413,DA,15,I,0))
|
|---|
| 37 | D ^XMB
|
|---|
| 38 | K XMB,NL,MSG,XMTEXT,XMY,XMDUZ
|
|---|
| 39 | Q
|
|---|
| 40 | CMR S (PRCNCMR,PRCN)=""
|
|---|
| 41 | F S PRCN=$O(^ENG(6914.1,"C",PRCNC,PRCN)) Q:PRCN="" S PRCNCMR(PRCN)=""
|
|---|
| 42 | F S PRCN=$O(^ENG(6914.1,"D",PRCNC,PRCN)) Q:PRCN="" S PRCNCMR(PRCN)=""
|
|---|
| 43 | Q
|
|---|
