source: WorldVistAEHR/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNFAP.m@ 1378

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

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1PRCNFAP ;SSI/ALA-Check for NX Capitalization (FAP) ;[ 02/19/97 11:33 AM ]
2 ;;1.0;PRCN;**2,3,15**;Sep 13, 1996
3FAC ; Check for FA completion
4 S TDA=0,STAT=23,CKA=1
5 F S TDA=$O(^PRCN(413.1,"AC",43,TDA)) Q:TDA="" D CK
6 G EXIT
7CK S STDT=$P(^PRCN(413.1,TDA,0),U,8)
8 K OLDVALUE ; PRCN*1.0*15
9 S (N,SFL)=0 F S N=$O(^PRCN(413.1,TDA,1,N)) Q:'N D
10 . S PRCNTI=$P(^PRCN(413.1,TDA,1,N,0),U)
11 . D:PRCNFLAG OVAL ; PRCN*1.0*15 get original CMR and SGL values
12 . S PRCNFDA=$$CHKFA^ENFAUTL(PRCNTI)
13 . I $G(CKA)=1 D CKA Q
14 . I $G(CKD)=1 D CKD
15 I SFL S DR="6////^S X=STAT;7////^S X=DT",(DIC,DIE)=413.1,DA=TDA D ^DIE
16 Q
17EXIT K STAT,STDT,N,PRCNTI,PRCNFDA,CKA,CKD,DIC,DIE,DA,DR
18 Q
19FDC ; Check for FD completion
20 S TDA=0,STAT=24,CKD=1
21 F S TDA=$O(^PRCN(413.1,"AC",44,TDA)) Q:TDA="" D CK
22 G EXIT
23CKA I ($P(PRCNFDA,U,2)>$P(PRCNFDA,U,3))&($P(PRCNFDA,U,2)'<STDT) S SFL=1
24 Q
25CKD I $P(PRCNFDA,U,3)'<STDT S SFL=1
26 Q
27 ;
28OVAL ; PRCN*1.0*15 get original CMR, Use Status and SGL values
29 N OLDCMR,OLDSGL,OLDUST
30 S OLDCMR=$P($G(^ENG(6914,PRCNTI,2)),U,9)
31 S OLDUST=$P($G(^ENG(6914,PRCNTI,3)),U,1)
32 S OLDSGL=$P($G(^ENG(6914,PRCNTI,8)),U,6)
33 S OLDVALUE(N)=PRCNTI_U_OLDCMR_U_OLDUST_U_OLDSGL
34 Q
Note: See TracBrowser for help on using the repository browser.