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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEEMP2 1330 printed Dec 13, 2024@02:26:37 Page 2
PRSEEMP2 ;HISC/MD-ATTENDANCE RPT BY SERVICE-CONT ;2/16/94
+1 ;;4.0;PAID;;Sep 21, 1995
SORT ; SORT INSERVICE DATA
+1 SET PRDATA=$GET(^PRSE(452,DA,0))
SET N1=$SELECT($PIECE($GET(^VA(200,+PRDATA,0)),U)'="":$PIECE(^(0),U),1:" BLNK")
SET NCD=$SELECT(+$PIECE(PRDATA,U,3):$PIECE(PRDATA,U,3),1:" BLNK")
SET NIC1=$SELECT('($PIECE(PRDATA,U,2)=""):$PIECE(PRDATA,U,2),1:" BLNK")
+2 SET PRSELOC=$SELECT($PIECE(PRDATA,U,13)'="":$PIECE(PRDATA,U,13),1:" BLNK")
IF $GET(PSP)'=1
if $GET(PSPC)'=PRSELOC
QUIT
+3 IF $DATA(NSPC)#2
IF $GET(NSPC)'=NIC1
QUIT
+4 SET PRSETL=""
SET SSN=$PIECE($GET(^VA(200,+PRDATA,1)),U,9)
if SSN=""
QUIT
SET PRDA=+$ORDER(^PRSPC("SSN",SSN,0))
SET PRCOD=$SELECT($PIECE($GET(^PRSPC(PRDA,0)),U,17)'="":$PIECE($GET(^(0)),U,17),1:0)
SET PRSETL=$$EN12^PRSEUTL2($GET(PRCOD))
if PRSETL=""
SET PRSETL=" BLNK"
+5 IF $SELECT('(PRSESEL="A")&($PIECE(PRDATA,U,21)=PRSESEL):0,PRSESEL="A":0,1:1)
QUIT
+6 if $GET(NSORT)=""
SET NSORT=1
+7 NEW X
SET X=$GET(^TMP("PRSE",$JOB,"L",PRSELOC,NIC1))
+8 IF X=""
SET X=NSORT
SET NSORT=NSORT+1
SET ^TMP("PRSE",$JOB,"L",PRSELOC,NIC1)=X
+9 SET PRSECLS(0)=+$ORDER(^PRSE(452.1,"B",NIC1,0))
+10 SET ^TMP("PRSE",$JOB,"L1",X,PRSETL,N1,NCD,DA)=$SELECT(+$GET(PRSECLS(0))>0:$PIECE($GET(^PRSE(452.1,PRSECLS(0),0)),U,3),1:$PIECE(PRDATA,U,16))_U_$PIECE(PRDATA,U,6)_U_$PIECE(PRDATA,U,10)_U_$PIECE(PRDATA,U,21)
+11 QUIT
L FOR 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"
SET ZTSAVE(X)=""
+1 QUIT