source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP21N.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PRCSP21N ;WISC/SAW-CONTROL POINT ACTIVITY 2237 PRINTOUT (PRE-PRINTED 8-1/2X11) CON'T ;1/19/93 10:47 AM ;
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 I '$D(^PRCS(410,DA,"RM",0)) G DEL
5 W ! S L=L+1,P(1)=0,DIWL=2,DIWR=54,DIWF="" K ^UTILITY($J,"W") S X="SPECIAL REMARKS" F J=1:1 S P(1)=$O(^PRCS(410,DA,"RM",P(1))) Q:P(1)="" S X=^(P(1),0) D DIWP^PRCUTL($G(DA))
6 S Z=^UTILITY($J,"W",DIWL) F K=1:1:Z S:L>29 F=1 D:F H^PRCSP2N S F=0 W !,?2,^UTILITY($J,"W",DIWL,K,0) S L=L+1
7DEL I L>29 S F=1 D H^PRCSP2N S F=0
8 I $D(^PRCS(410,DA,9)) S X=$P(^(9),U) I X'="" W !,?7,"DELIVER TO: ",X S L=L+1 W $C(13),?18 S I="",$P(I,"_",$L(X))="" W I S I=""
9 F I=1:1:(33-L) W !
10 S L=33 I '$D(^PRCS(410,DA,8,0)) G SIG
11 S DIWL=2,DIWR=70,DIWF="" K ^UTILITY($J,"W") S X1=0 F I=1:1 S X1=$O(^PRCS(410,DA,8,X1)) Q:X1="" S X=^(X1,0) D DIWP^PRCUTL($G(DA))
12 S Z=^UTILITY($J,"W",DIWL) S:Z>5 Z=5 F K=1:1:Z W ?2,^UTILITY($J,"W",DIWL,K,0),! S L=L+1
13SIG ;PRINT SIGNATURE BLOCKS
14 F I=1:1:(38-L) W !
15 S L=38 I '$D(^PRCS(410,DA,7)) G APP
16 I $P(^PRCS(410,DA,7),U)'="" S P=$P(^(7),U),X=$P(^DD(410,40,0),"^",2) I X[200 S P=$S($D(^VA(200,+P,0)):$P(^(0),U),1:"") W ?2,P
17 I $P(^PRCS(410,DA,7),U,6)'="" W ?48,"/ES/",$$DECODE^PRCSC1(DA)
18 I $P(^PRCS(410,DA,7),U,6)="",$P(^(7),U,3)'="" S P=$P(^(7),U,3),X=$P(^DD(410,42,0),"^",2) I X[200 S P=$S($D(^VA(200,+P,0)):$P(^(0),U),1:"") W ?48,P
19 W !,?2 W:$P(^PRCS(410,DA,7),U,2)'="" $P(^(7),U,2) W:$P(^(7),U,4)'="" ?48,$P(^(7),U,4) I $P(^(7),U,5)'="" S Y=$P(^(7),U,5) D DD^%DT W ?81,Y
20APP F I=1:1:(58-L) W !
21 S P=$P(^PRCS(410,DA,0),U,5) I $D(^(3)) S:$P(^(3),U,2)'="" P=P_"-"_$P(^(3),U,2) S:$P(^(3),U)'="" P=P_"-"_$E($P(^(3),U),1,3) S:$P(^(3),U,3)'="" P=P_"-"_$E($P(^(3),U,3),1,4) S:$D(PRCS("SUB")) P=P_"-"_PRCS("SUB")
22 I $D(^PRCS(410,DA,4)),$P(^(4),U,5)'="" S P=P_"-"_$P(^(4),U,5)
23 W ?2,P,! Q
Note: See TracBrowser for help on using the repository browser.