- 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 Mar 13, 2025@21:20:05 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
