source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEEMP2.m

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1PRSEEMP2 ;HISC/MD-ATTENDANCE RPT BY SERVICE-CONT ;2/16/94
2 ;;4.0;PAID;;Sep 21, 1995
3SORT ; SORT INSERVICE DATA
4 S PRDATA=$G(^PRSE(452,DA,0)),N1=$S($P($G(^VA(200,+PRDATA,0)),U)'="":$P(^(0),U),1:" BLNK"),NCD=$S(+$P(PRDATA,U,3):$P(PRDATA,U,3),1:" BLNK"),NIC1=$S('($P(PRDATA,U,2)=""):$P(PRDATA,U,2),1:" BLNK")
5 S PRSELOC=$S($P(PRDATA,U,13)'="":$P(PRDATA,U,13),1:" BLNK") I $G(PSP)'=1 Q:$G(PSPC)'=PRSELOC
6 I $D(NSPC)#2,$G(NSPC)'=NIC1 Q
7 S PRSETL="",SSN=$P($G(^VA(200,+PRDATA,1)),U,9) Q:SSN="" S PRDA=+$O(^PRSPC("SSN",SSN,0)) S PRCOD=$S($P($G(^PRSPC(PRDA,0)),U,17)'="":$P($G(^(0)),U,17),1:0),PRSETL=$$EN12^PRSEUTL2($G(PRCOD)) S:PRSETL="" PRSETL=" BLNK"
8 I $S('(PRSESEL="A")&($P(PRDATA,U,21)=PRSESEL):0,PRSESEL="A":0,1:1) Q
9 S:$G(NSORT)="" NSORT=1
10 N X S X=$G(^TMP("PRSE",$J,"L",PRSELOC,NIC1))
11 I X="" S X=NSORT,NSORT=NSORT+1,^TMP("PRSE",$J,"L",PRSELOC,NIC1)=X
12 S PRSECLS(0)=+$O(^PRSE(452.1,"B",NIC1,0))
13 S ^TMP("PRSE",$J,"L1",X,PRSETL,N1,NCD,DA)=$S(+$G(PRSECLS(0))>0:$P($G(^PRSE(452.1,PRSECLS(0),0)),U,3),1:$P(PRDATA,U,16))_U_$P(PRDATA,U,6)_U_$P(PRDATA,U,10)_U_$P(PRDATA,U,21)
14 Q
15L F X="PHRS*","SHRS*","RHRS*","RCNT","PCNT","SCNT","PSPC","PSPC*","PSP","PYR","PRDA","HOLD*","PRSECLS","PRSESEL","PRSESER","NSW2","POUT","REQWRD","NQ","NSP","NSP*","NSPC","NSPC*","NPC","POUT","NSW1","PRSECORD","TYP" S ZTSAVE(X)=""
16 Q
Note: See TracBrowser for help on using the repository browser.