NURQRPT3 ;HIRMFO/YH-ROUTINE TO PRINT 10 STEP REPORT, PART 4 ;3/21/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
COMUN S NURQDC=$P($G(^NURQ(217,DA,8,D1,0)),"^",2) W:NURQDC'="" $E(NURQDC,4,5)_"-"_$E(NURQDC,6,7)_"-"_$E(NURQDC,2,3)
Q
REFER ;PRINT REFERENCE INFORMATION
W !,"D. REFERENCE:" I $P($G(^NURQ(217,DA,9,0)),"^",3)>0 D
.S NURQTXT=" " F D1=0:0 S D1=$O(^NURQ(217,DA,9,D1)) Q:D1'>0!$G(NUROUT) S NURQTXT=NURQTXT_" "_$P($G(^NURQ(217,DA,9,D1,0)),"^")
.Q:$G(NUROUT) S NURQTXT(1)=$E(NURQB,1,3) D DIWP(.NURQTXT)
;PRINT OTHER QI INFORMATION
Q:$G(NUROUT) W !,"E. OTHER:" I $P($G(^NURQ(217,DA,11,0)),"^",3)>0 D
.S NURQTXT=" " F D1=0:0 S D1=$O(^NURQ(217,DA,11,D1)) Q:D1'>0!$G(NUROUT) S NURQTXT=NURQTXT_" "_$G(^NURQ(217,DA,11,D1,0))
.Q:$G(NUROUT) S NURQTXT(1)=$E(NURQB,1,3) D DIWP(.NURQTXT)
Q
WRITE ;PRINT IMPORTANT FUNCTION TABLE
;NFUNC ARRAY CONTAINS TEXT OF IMPORTANT FUNCTIONS
;NCARE ARRAY CONTAINS TEXT OF STANDARD OF CARE_ASSOCIATESERVICE
;NPRACT ARRAY CONTAINS TEXT OF STANDARD OF PRACTICE_ASSOCIATE SERVICE
;NLEVL IS NUMBER OF ROWS
Q:NLEVL'>0
N NII F NII=1:1:NLEVL D:($Y>(IOSL-7)) HDR^NURQRPT0,FHEADR^NURQRPT0 Q:$G(NUROUT) W ! D
.I $D(NFUNC(+NII)) W NFUNC(+NII)
.I $D(NCARE(+NII)) W ?21,NCARE(+NII)
.I $D(NPRACT(+NII)) W ?51,NPRACT(+NII)
K NLEVL,NPRACT,NCARE,NFUNC Q
DIWP(NTEXT) ;INPUT NTEXT CONTAINS WP TEXT
;^UTILITY($J,"W") CONTAINS THE ^DIWP OUTPUT
K ^UTILITY($J) S X=NTEXT,DIWF="",DIWL=0,DIWR=76 D ^DIWP
Q:'$D(^UTILITY($J,"W")) N NX,NY S NX=0 F S NX=$O(^UTILITY($J,"W",0,NX)) Q:NX'>0!$G(NUROUT) S NY=$G(^UTILITY($J,"W",0,NX,0)) D:($Y>(IOSL-7)) HDR^NURQRPT0 Q:$G(NUROUT) W !,$S(NX=1:NY,1:NTEXT(1)_NY)
Q
MERGE(NTEXT,NLEN) ;MERGE ^UTILITY($J,"W") TO NTEXT ARRAY WITH TEXT LENGTH<=NLEN
N I S (NTEXT,I)=0 F S I=$O(^UTILITY($J,"W",0,I)) Q:I'>0 S I(1)=$G(^UTILITY($J,"W",0,I,0)) D
.I $L(I(1))>NLEN D CUT Q
.E S NTEXT=NTEXT+1,NTEXT(NTEXT)=I(1)
Q
CUT S NTEXT=NTEXT+1,NTEXT(NTEXT)=$E(I(1),1,NLEN),I(1)=$E(I(1),NLEN+1,40)
I $L(I(1))>NLEN G CUT
S NTEXT=NTEXT+1,NTEXT(NTEXT)=I(1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURQRPT3 2049 printed Dec 13, 2024@02:21:12 Page 2
NURQRPT3 ;HIRMFO/YH-ROUTINE TO PRINT 10 STEP REPORT, PART 4 ;3/21/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
COMUN SET NURQDC=$PIECE($GET(^NURQ(217,DA,8,D1,0)),"^",2)
if NURQDC'=""
WRITE $EXTRACT(NURQDC,4,5)_"-"_$EXTRACT(NURQDC,6,7)_"-"_$EXTRACT(NURQDC,2,3)
+1 QUIT
REFER ;PRINT REFERENCE INFORMATION
+1 WRITE !,"D. REFERENCE:"
IF $PIECE($GET(^NURQ(217,DA,9,0)),"^",3)>0
Begin DoDot:1
+2 SET NURQTXT=" "
FOR D1=0:0
SET D1=$ORDER(^NURQ(217,DA,9,D1))
if D1'>0!$GET(NUROUT)
QUIT
SET NURQTXT=NURQTXT_" "_$PIECE($GET(^NURQ(217,DA,9,D1,0)),"^")
+3 if $GET(NUROUT)
QUIT
SET NURQTXT(1)=$EXTRACT(NURQB,1,3)
DO DIWP(.NURQTXT)
End DoDot:1
+4 ;PRINT OTHER QI INFORMATION
+5 if $GET(NUROUT)
QUIT
WRITE !,"E. OTHER:"
IF $PIECE($GET(^NURQ(217,DA,11,0)),"^",3)>0
Begin DoDot:1
+6 SET NURQTXT=" "
FOR D1=0:0
SET D1=$ORDER(^NURQ(217,DA,11,D1))
if D1'>0!$GET(NUROUT)
QUIT
SET NURQTXT=NURQTXT_" "_$GET(^NURQ(217,DA,11,D1,0))
+7 if $GET(NUROUT)
QUIT
SET NURQTXT(1)=$EXTRACT(NURQB,1,3)
DO DIWP(.NURQTXT)
End DoDot:1
+8 QUIT
WRITE ;PRINT IMPORTANT FUNCTION TABLE
+1 ;NFUNC ARRAY CONTAINS TEXT OF IMPORTANT FUNCTIONS
+2 ;NCARE ARRAY CONTAINS TEXT OF STANDARD OF CARE_ASSOCIATESERVICE
+3 ;NPRACT ARRAY CONTAINS TEXT OF STANDARD OF PRACTICE_ASSOCIATE SERVICE
+4 ;NLEVL IS NUMBER OF ROWS
+5 if NLEVL'>0
QUIT
+6 NEW NII
FOR NII=1:1:NLEVL
if ($Y>(IOSL-7))
DO HDR^NURQRPT0
DO FHEADR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !
Begin DoDot:1
+7 IF $DATA(NFUNC(+NII))
WRITE NFUNC(+NII)
+8 IF $DATA(NCARE(+NII))
WRITE ?21,NCARE(+NII)
+9 IF $DATA(NPRACT(+NII))
WRITE ?51,NPRACT(+NII)
End DoDot:1
+10 KILL NLEVL,NPRACT,NCARE,NFUNC
QUIT
DIWP(NTEXT) ;INPUT NTEXT CONTAINS WP TEXT
+1 ;^UTILITY($J,"W") CONTAINS THE ^DIWP OUTPUT
+2 KILL ^UTILITY($JOB)
SET X=NTEXT
SET DIWF=""
SET DIWL=0
SET DIWR=76
DO ^DIWP
+3 if '$DATA(^UTILITY($JOB,"W"))
QUIT
NEW NX,NY
SET NX=0
FOR
SET NX=$ORDER(^UTILITY($JOB,"W",0,NX))
if NX'>0!$GET(NUROUT)
QUIT
SET NY=$GET(^UTILITY($JOB,"W",0,NX,0))
if ($Y>(IOSL-7))
DO HDR^NURQRPT0
if $GET(NUROUT)
QUIT
WRITE !,$SELECT(NX=1:NY,1:NTEXT(1)_NY)
+4 QUIT
MERGE(NTEXT,NLEN) ;MERGE ^UTILITY($J,"W") TO NTEXT ARRAY WITH TEXT LENGTH<=NLEN
+1 NEW I
SET (NTEXT,I)=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",0,I))
if I'>0
QUIT
SET I(1)=$GET(^UTILITY($JOB,"W",0,I,0))
Begin DoDot:1
+2 IF $LENGTH(I(1))>NLEN
DO CUT
QUIT
+3 IF '$TEST
SET NTEXT=NTEXT+1
SET NTEXT(NTEXT)=I(1)
End DoDot:1
+4 QUIT
CUT SET NTEXT=NTEXT+1
SET NTEXT(NTEXT)=$EXTRACT(I(1),1,NLEN)
SET I(1)=$EXTRACT(I(1),NLEN+1,40)
+1 IF $LENGTH(I(1))>NLEN
GOTO CUT
+2 SET NTEXT=NTEXT+1
SET NTEXT(NTEXT)=I(1)
+3 QUIT
