Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSEEMP2

PRSEEMP2.m

Go to the documentation of this file.
PRSEEMP2 ;HISC/MD-ATTENDANCE RPT BY SERVICE-CONT ;2/16/94
 ;;4.0;PAID;;Sep 21, 1995
SORT ; SORT INSERVICE DATA
 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")
 S PRSELOC=$S($P(PRDATA,U,13)'="":$P(PRDATA,U,13),1:"  BLNK") I $G(PSP)'=1 Q:$G(PSPC)'=PRSELOC
 I $D(NSPC)#2,$G(NSPC)'=NIC1 Q
 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"
 I $S('(PRSESEL="A")&($P(PRDATA,U,21)=PRSESEL):0,PRSESEL="A":0,1:1) Q
 S:$G(NSORT)="" NSORT=1
 N X S X=$G(^TMP("PRSE",$J,"L",PRSELOC,NIC1))
 I X="" S X=NSORT,NSORT=NSORT+1,^TMP("PRSE",$J,"L",PRSELOC,NIC1)=X
 S PRSECLS(0)=+$O(^PRSE(452.1,"B",NIC1,0))
 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)
 Q
L 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)=""
 Q