35 lines
1.1 KiB
Mathematica
35 lines
1.1 KiB
Mathematica
PRCNFAP ;SSI/ALA-Check for NX Capitalization (FAP) ;[ 02/19/97 11:33 AM ]
|
|
;;1.0;PRCN;**2,3,15**;Sep 13, 1996
|
|
FAC ; Check for FA completion
|
|
S TDA=0,STAT=23,CKA=1
|
|
F S TDA=$O(^PRCN(413.1,"AC",43,TDA)) Q:TDA="" D CK
|
|
G EXIT
|
|
CK S STDT=$P(^PRCN(413.1,TDA,0),U,8)
|
|
K OLDVALUE ; PRCN*1.0*15
|
|
S (N,SFL)=0 F S N=$O(^PRCN(413.1,TDA,1,N)) Q:'N D
|
|
. S PRCNTI=$P(^PRCN(413.1,TDA,1,N,0),U)
|
|
. D:PRCNFLAG OVAL ; PRCN*1.0*15 get original CMR and SGL values
|
|
. S PRCNFDA=$$CHKFA^ENFAUTL(PRCNTI)
|
|
. I $G(CKA)=1 D CKA Q
|
|
. I $G(CKD)=1 D CKD
|
|
I SFL S DR="6////^S X=STAT;7////^S X=DT",(DIC,DIE)=413.1,DA=TDA D ^DIE
|
|
Q
|
|
EXIT K STAT,STDT,N,PRCNTI,PRCNFDA,CKA,CKD,DIC,DIE,DA,DR
|
|
Q
|
|
FDC ; Check for FD completion
|
|
S TDA=0,STAT=24,CKD=1
|
|
F S TDA=$O(^PRCN(413.1,"AC",44,TDA)) Q:TDA="" D CK
|
|
G EXIT
|
|
CKA I ($P(PRCNFDA,U,2)>$P(PRCNFDA,U,3))&($P(PRCNFDA,U,2)'<STDT) S SFL=1
|
|
Q
|
|
CKD I $P(PRCNFDA,U,3)'<STDT S SFL=1
|
|
Q
|
|
;
|
|
OVAL ; PRCN*1.0*15 get original CMR, Use Status and SGL values
|
|
N OLDCMR,OLDSGL,OLDUST
|
|
S OLDCMR=$P($G(^ENG(6914,PRCNTI,2)),U,9)
|
|
S OLDUST=$P($G(^ENG(6914,PRCNTI,3)),U,1)
|
|
S OLDSGL=$P($G(^ENG(6914,PRCNTI,8)),U,6)
|
|
S OLDVALUE(N)=PRCNTI_U_OLDCMR_U_OLDUST_U_OLDSGL
|
|
Q
|