Routine: PRSEEMP2

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)

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)=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEEMP2   1330     printed  Mar 13, 2025@21:31:39                                                                                                                                                                                                    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

PRSEEMP2.m