PSBOCI1.m

PSBOCI1 ;BIRMINGHAM/TEJ-COVERSHEET IV OVERVIEW REPORT ;Mar 2004

 ;;3.0;BAR CODE MED ADMIN;**32**;Mar 2004;Build 32

 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.

 ;

 ;

BUILDLN ; Constr recs

 K J S J(0)="" F PSBFLD=1:1:7  S J=1 D FORMDAT^PSBOCE1(PSBFLD) S J($O(PSBRPLN(""),-1))=""

 ; Write administration info...

 Q:'PSBXFLG

 ; Get Actions

 K PSBXDTL S (PSBXDTL,N,Y)="",J=($O(J(""),-1)+1)

 D BAGDTL^PSBRPC2(.PSBXDTL,XI,PSBX2X)

 I $D(PSBXDTL(1)) I +$P(PSBXDTL(1),U)=-1 S PSBRPLN(J)=PSBBLANK,J(J)="",J=J+1 Q

 S J=($O(J(""),-1)+1),PSBRPLN(J)=PSBBLANK,J(J)="",J=J+1

 F Y=1:1:PSBXDTL(0)  S N=PSBXDTL(Y) D

 .Q:('PSBCFLG)&($P(N,U,3)']"")

 .S $E(PSBDATA(2,0),25)="BY: "_$P(N,U,2)_" "_$$FMTDT^PSBOCE1($E($P(N,U),1,12))

 .S $E(PSBDATA(2,0),49)="ACTION: "_$P(N,U,3)

 .I $G(PSBDATA(2,0))]" " D WRAPPER^PSBOCE1(1,132-1,PSBDATA(2,0)) K PSBDATA(2) S J=J+1

 .M PSBLGD("INITIALS")=PSBLGD(PSBX2X,"INITIALS")

 .Q:('PSBCFLG)!($P(N,U,4)']"")

 .S PSBDATA(2,0)=$G(PSBDATA(2,0),"")_"  COMMENT: "_$P(N,U,4)

 .I $G(PSBDATA(2,0))]" " D WRAPPER^PSBOCE1(49,132-49,PSBDATA(2,0)) K PSBDATA(2) S J=J+1

 S PSBRPLN(J)=PSBBLANK,J(J)="",J=J+1

 Q

PTFTR ;Patient Page footer

 I (IOSL<100) F  Q:$Y>(IOSL-7)  W !

 W !,$TR($J("",IOM)," ","=")

 S X="Ward: "_PSBHDR("WARD")_"  Room-Bed: "_PSBHDR("ROOM")

 W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X

 S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))

 S PSBPGRM=PSBTAB7-($L(PSBPG))

 W !,PSBRPNM,"     ",?(PSBPGRM-($L(PSBDTTM)+3)),PSBDTTM_"  "_PSBPG

 Q

PSBOCI1   ;BIRMINGHAM/TEJ-COVERSHEET IV OVERVIEW REPORT ;Mar 2004

 +1       ;;3.0;BAR CODE MED ADMIN;**32**;Mar 2004;Build 32

 +2       ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.

 +3       ;

 +4       ;

BUILDLN   ; Constr recs

 +1        KILL J

           SET J(0)=""

           FOR PSBFLD=1:1:7

               SET J=1

               DO FORMDAT^PSBOCE1(PSBFLD)

               SET J($ORDER(PSBRPLN(""),-1))=""

 +2       ; Write administration info...

 +3        IF 'PSBXFLG

               QUIT 

 +4       ; Get Actions

 +5        KILL PSBXDTL

           SET (PSBXDTL,N,Y)=""

           SET J=($ORDER(J(""),-1)+1)

 +6        DO BAGDTL^PSBRPC2(.PSBXDTL,XI,PSBX2X)

 +7        IF $DATA(PSBXDTL(1))

               IF +$PIECE(PSBXDTL(1),U)=-1

                   SET PSBRPLN(J)=PSBBLANK

                   SET J(J)=""

                   SET J=J+1

                   QUIT 

 +8        SET J=($ORDER(J(""),-1)+1)

           SET PSBRPLN(J)=PSBBLANK

           SET J(J)=""

           SET J=J+1

 +9        FOR Y=1:1:PSBXDTL(0)

               SET N=PSBXDTL(Y)

               Begin DoDot:1

 +10               IF ('PSBCFLG)&($PIECE(N,U,3)']"")

                       QUIT 

 +11               SET $EXTRACT(PSBDATA(2,0),25)="BY: "_$PIECE(N,U,2)_" "_$$FMTDT^PSBOCE1($EXTRACT($PIECE(N,U),1,12))

 +12               SET $EXTRACT(PSBDATA(2,0),49)="ACTION: "_$PIECE(N,U,3)

 +13               IF $GET(PSBDATA(2,0))]" "

                       DO WRAPPER^PSBOCE1(1,132-1,PSBDATA(2,0))

                       KILL PSBDATA(2)

                       SET J=J+1

 +14               MERGE PSBLGD("INITIALS")=PSBLGD(PSBX2X,"INITIALS")

 +15               IF ('PSBCFLG)!($PIECE(N,U,4)']"")

                       QUIT 

 +16               SET PSBDATA(2,0)=$GET(PSBDATA(2,0),"")_"  COMMENT: "_$PIECE(N,U,4)

 +17               IF $GET(PSBDATA(2,0))]" "

                       DO WRAPPER^PSBOCE1(49,132-49,PSBDATA(2,0))

                       KILL PSBDATA(2)

                       SET J=J+1

               End DoDot:1

 +18       SET PSBRPLN(J)=PSBBLANK

           SET J(J)=""

           SET J=J+1

 +19       QUIT 

PTFTR     ;Patient Page footer

 +1        IF (IOSL<100)

               FOR 

                   IF $Y>(IOSL-7)

                       QUIT 

                   WRITE !

 +2        WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","=")

 +3        SET X="Ward: "_PSBHDR("WARD")_"  Room-Bed: "_PSBHDR("ROOM")

 +4        WRITE !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$LENGTH(X)),X

 +5        SET PSBPG="Page: "_PSBPGNUM_" of "_$SELECT($ORDER(PSBOUTP(""),-1)=0:1,1:$ORDER(PSBOUTP(""),-1))

 +6        SET PSBPGRM=PSBTAB7-($LENGTH(PSBPG))

 +7        WRITE !,PSBRPNM,"     ",?(PSBPGRM-($LENGTH(PSBDTTM)+3)),PSBDTTM_"  "_PSBPG

 +8        QUIT