PRCPRPHP ;WISC/RFJ-physical count form for prim and sec;02 Feb 93 ; 3/22/99 11:32am
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
N %,%H,%I,D,DESCR,G,GROUP,GROUPALL,GROUPNM,ITEMDA,MAIN,NOW,PAGE,PRCPEXIT,PRCPFLAG,PRCPOH,SCREEN,X,Y
S PRCPOH=0
S XP="Do you need to print the ON-HAND column"
S XH="Enter 'YES' only if you are NOT performing a physical count."
W ! S %=$$YN^PRCPUYN(2)
I %=0 Q
I %=1 S PRCPOH=1
W !!,"Selected group categories will be used to generate the physical count form."
K ^TMP($J,"PRCPRPH") D ALLGRP I $G(PRCPFLAG) Q
F D I $G(PRCPFLAG) Q
. I $O(^TMP($J,"PRCPRPH","YES",0))!($G(GROUPALL)) D
. . W !!," Currently selected group categories:",!," "
. . I $G(GROUPALL) W "<< ALL GROUP CATEGORIES >>"
. . 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 %," "
. . W !," You can DE-select one of the above group categories by reselecting it."
. I $O(^TMP($J,"PRCPRPH","NO",0)) D
. . W !!," Currently DE-selected group categories:",!," "
. . 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 %," "
. . W !," You can RE-select one of the above group categories by reselecting it."
. W !!,"Select the name of the group category created for this primary, '^' to exit."
. S GROUP=$$GROUP^PRCPEGRP(PRCP("I"),"") I GROUP<0 S (PRCPFLAG,PRCPEXIT)=1 Q
. S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
. I GROUP=0,'$O(^TMP($J,"PRCPRPH","YES",0)),'$G(GROUPALL) D ALLGRP S:$G(PRCPFLAG) PRCPEXIT=1 Q
. I GROUP=0 S PRCPFLAG=1 Q
. 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
. 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
. I $D(^TMP($J,"PRCPRPH","NO",GROUP)) K ^(GROUP) S ^TMP($J,"PRCPRPH","YES",GROUP)=GROUPNM W !?10,"RE-selected !" Q
. S ^TMP($J,"PRCPRPH","YES",GROUP)=GROUPNM W !?10,"selected !"
I $G(PRCPEXIT) D Q^PRCPRPH1 Q
I $G(GROUPALL) K ^TMP($J,"PRCPRPH","YES")
I '$G(GROUPALL),'$O(^TMP($J,"PRCPRPH","YES",0)) W !!,"NO GROUP CATEGORIES SELECTED." D Q^PRCPRPH1 Q
;
S %ZIS="Q" W ! D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="Physical Count Form",ZTRTN="DQ^PRCPRPH1"
. S ZTSAVE("PRCP*")="",ZTSAVE("GROUPALL")="",ZTSAVE("^TMP($J,""PRCPRPH"",")="",ZTSAVE("ZTREQ")="@"
W !!,"<*> please wait <*>"
D DQ^PRCPRPH1 Q
;
;
ALLGRP ;select all groups
K GROUPALL,PRCPFLAG
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"
S XH(2)="or enter '^' to exit."
W ! S %=$$YN^PRCPUYN(1)
I %=2 Q
I %=1 S GROUPALL=1 Q
S PRCPFLAG=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRPHP 3076 printed Apr 09, 2024@21:18:09 Page 2
PRCPRPHP ;WISC/RFJ-physical count form for prim and sec;02 Feb 93 ; 3/22/99 11:32am
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+3 NEW %,%H,%I,D,DESCR,G,GROUP,GROUPALL,GROUPNM,ITEMDA,MAIN,NOW,PAGE,PRCPEXIT,PRCPFLAG,PRCPOH,SCREEN,X,Y
+4 SET PRCPOH=0
+5 SET XP="Do you need to print the ON-HAND column"
+6 SET XH="Enter 'YES' only if you are NOT performing a physical count."
+7 WRITE !
SET %=$$YN^PRCPUYN(2)
+8 IF %=0
QUIT
+9 IF %=1
SET PRCPOH=1
+10 WRITE !!,"Selected group categories will be used to generate the physical count form."
+11 KILL ^TMP($JOB,"PRCPRPH")
DO ALLGRP
IF $GET(PRCPFLAG)
QUIT
+12 FOR
Begin DoDot:1
+13 IF $ORDER(^TMP($JOB,"PRCPRPH","YES",0))!($GET(GROUPALL))
Begin DoDot:2
+14 WRITE !!," Currently selected group categories:",!," "
+15 IF $GET(GROUPALL)
WRITE "<< ALL GROUP CATEGORIES >>"
+16 IF '$TEST
SET G=0
FOR
SET G=$ORDER(^TMP($JOB,"PRCPRPH","YES",G))
if 'G
QUIT
SET %=$EXTRACT(^(G),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE !," "
WRITE %," "
+17 WRITE !," You can DE-select one of the above group categories by reselecting it."
End DoDot:2
+18 IF $ORDER(^TMP($JOB,"PRCPRPH","NO",0))
Begin DoDot:2
+19 WRITE !!," Currently DE-selected group categories:",!," "
+20 SET G=0
FOR
SET G=$ORDER(^TMP($JOB,"PRCPRPH","NO",G))
if 'G
QUIT
SET %=$EXTRACT(^(G),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE !," "
WRITE %," "
+21 WRITE !," You can RE-select one of the above group categories by reselecting it."
End DoDot:2
+22 WRITE !!,"Select the name of the group category created for this primary, '^' to exit."
+23 SET GROUP=$$GROUP^PRCPEGRP(PRCP("I"),"")
IF GROUP<0
SET (PRCPFLAG,PRCPEXIT)=1
QUIT
+24 SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
+25 IF GROUP=0
IF '$ORDER(^TMP($JOB,"PRCPRPH","YES",0))
IF '$GET(GROUPALL)
DO ALLGRP
if $GET(PRCPFLAG)
SET PRCPEXIT=1
QUIT
+26 IF GROUP=0
SET PRCPFLAG=1
QUIT
+27 IF $GET(GROUPALL)
IF '$DATA(^TMP($JOB,"PRCPRPH","NO",GROUP))
KILL ^TMP($JOB,"PRCPRPH","YES",GROUP)
SET ^TMP($JOB,"PRCPRPH","NO",GROUP)=GROUPNM
WRITE !?10,"DE-selected !"
QUIT
+28 IF $DATA(^TMP($JOB,"PRCPRPH","YES",GROUP))
KILL ^TMP($JOB,"PRCPRPH","YES",GROUP)
SET ^TMP($JOB,"PRCPRPH","NO",GROUP)=GROUPNM
WRITE !?10,"DE-selected !"
QUIT
+29 IF $DATA(^TMP($JOB,"PRCPRPH","NO",GROUP))
KILL ^(GROUP)
SET ^TMP($JOB,"PRCPRPH","YES",GROUP)=GROUPNM
WRITE !?10,"RE-selected !"
QUIT
+30 SET ^TMP($JOB,"PRCPRPH","YES",GROUP)=GROUPNM
WRITE !?10,"selected !"
End DoDot:1
IF $GET(PRCPFLAG)
QUIT
+31 IF $GET(PRCPEXIT)
DO Q^PRCPRPH1
QUIT
+32 IF $GET(GROUPALL)
KILL ^TMP($JOB,"PRCPRPH","YES")
+33 IF '$GET(GROUPALL)
IF '$ORDER(^TMP($JOB,"PRCPRPH","YES",0))
WRITE !!,"NO GROUP CATEGORIES SELECTED."
DO Q^PRCPRPH1
QUIT
+34 ;
+35 SET %ZIS="Q"
WRITE !
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
Begin DoDot:1
+36 SET ZTDESC="Physical Count Form"
SET ZTRTN="DQ^PRCPRPH1"
+37 SET ZTSAVE("PRCP*")=""
SET ZTSAVE("GROUPALL")=""
SET ZTSAVE("^TMP($J,""PRCPRPH"",")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+38 WRITE !!,"<*> please wait <*>"
+39 DO DQ^PRCPRPH1
QUIT
+40 ;
+41 ;
ALLGRP ;select all groups
+1 KILL GROUPALL,PRCPFLAG
+2 SET XP="Do you want to select ALL group categories"
SET XH="Enter 'YES' to generate the physical count form for ALL group categories"
SET XH(1)="enter 'NO' to print the physical count form for selected group categories"
+3 SET XH(2)="or enter '^' to exit."
+4 WRITE !
SET %=$$YN^PRCPUYN(1)
+5 IF %=2
QUIT
+6 IF %=1
SET GROUPALL=1
QUIT
+7 SET PRCPFLAG=1
QUIT
