source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRPHP.m@ 1389

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1PRCPRPHP ;WISC/RFJ-physical count form for prim and sec;02 Feb 93 ; 3/22/99 11:32am
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 N %,%H,%I,D,DESCR,G,GROUP,GROUPALL,GROUPNM,ITEMDA,MAIN,NOW,PAGE,PRCPEXIT,PRCPFLAG,PRCPOH,SCREEN,X,Y
6 S PRCPOH=0
7 S XP="Do you need to print the ON-HAND column"
8 S XH="Enter 'YES' only if you are NOT performing a physical count."
9 W ! S %=$$YN^PRCPUYN(2)
10 I %=0 Q
11 I %=1 S PRCPOH=1
12 W !!,"Selected group categories will be used to generate the physical count form."
13 K ^TMP($J,"PRCPRPH") D ALLGRP I $G(PRCPFLAG) Q
14 F D I $G(PRCPFLAG) Q
15 . I $O(^TMP($J,"PRCPRPH","YES",0))!($G(GROUPALL)) D
16 . . W !!," Currently selected group categories:",!," "
17 . . I $G(GROUPALL) W "<< ALL GROUP CATEGORIES >>"
18 . . E S G=0 F S G=$O(^TMP($J,"PRCPRPH","YES",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
19 . . W !," You can DE-select one of the above group categories by reselecting it."
20 . I $O(^TMP($J,"PRCPRPH","NO",0)) D
21 . . W !!," Currently DE-selected group categories:",!," "
22 . . S G=0 F S G=$O(^TMP($J,"PRCPRPH","NO",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
23 . . W !," You can RE-select one of the above group categories by reselecting it."
24 . W !!,"Select the name of the group category created for this primary, '^' to exit."
25 . S GROUP=$$GROUP^PRCPEGRP(PRCP("I"),"") I GROUP<0 S (PRCPFLAG,PRCPEXIT)=1 Q
26 . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
27 . I GROUP=0,'$O(^TMP($J,"PRCPRPH","YES",0)),'$G(GROUPALL) D ALLGRP S:$G(PRCPFLAG) PRCPEXIT=1 Q
28 . I GROUP=0 S PRCPFLAG=1 Q
29 . I $G(GROUPALL),'$D(^TMP($J,"PRCPRPH","NO",GROUP)) K ^TMP($J,"PRCPRPH","YES",GROUP) S ^TMP($J,"PRCPRPH","NO",GROUP)=GROUPNM W !?10,"DE-selected !" Q
30 . I $D(^TMP($J,"PRCPRPH","YES",GROUP)) K ^TMP($J,"PRCPRPH","YES",GROUP) S ^TMP($J,"PRCPRPH","NO",GROUP)=GROUPNM W !?10,"DE-selected !" Q
31 . I $D(^TMP($J,"PRCPRPH","NO",GROUP)) K ^(GROUP) S ^TMP($J,"PRCPRPH","YES",GROUP)=GROUPNM W !?10,"RE-selected !" Q
32 . S ^TMP($J,"PRCPRPH","YES",GROUP)=GROUPNM W !?10,"selected !"
33 I $G(PRCPEXIT) D Q^PRCPRPH1 Q
34 I $G(GROUPALL) K ^TMP($J,"PRCPRPH","YES")
35 I '$G(GROUPALL),'$O(^TMP($J,"PRCPRPH","YES",0)) W !!,"NO GROUP CATEGORIES SELECTED." D Q^PRCPRPH1 Q
36 ;
37 S %ZIS="Q" W ! D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
38 . S ZTDESC="Physical Count Form",ZTRTN="DQ^PRCPRPH1"
39 . S ZTSAVE("PRCP*")="",ZTSAVE("GROUPALL")="",ZTSAVE("^TMP($J,""PRCPRPH"",")="",ZTSAVE("ZTREQ")="@"
40 W !!,"<*> please wait <*>"
41 D DQ^PRCPRPH1 Q
42 ;
43 ;
44ALLGRP ;select all groups
45 K GROUPALL,PRCPFLAG
46 S XP="Do you want to select ALL group categories",XH="Enter 'YES' to generate the physical count form for ALL group categories",XH(1)="enter 'NO' to print the physical count form for selected group categories"
47 S XH(2)="or enter '^' to exit."
48 W ! S %=$$YN^PRCPUYN(1)
49 I %=2 Q
50 I %=1 S GROUPALL=1 Q
51 S PRCPFLAG=1 Q
Note: See TracBrowser for help on using the repository browser.