Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPRINQ

PRCPRINQ.m

Go to the documentation of this file. 
  1. PRCPRINQ ;WISC/RFJ-inquire to inventory files                       ;10 Feb 94
  1.  ;;5.1;IFCAP;;Oct 20, 2000
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  D ^PRCPUSEL Q:'$G(PRCP("I"))
  1.  N %,COSTDA,DA,DATETIME,DIC,DIR,DR,GROUPDA,ITEMDA,ORDERDA,PRCPFILE,PRCPFLAG,PRCPPRIV,STOREDA,TRANDA,X,Y
  1.  S DIR(0)="SO^"
  1.  F %=2:1 S X=$P($T(FILES+%),";",3,4) Q:X=""  I $P(X,";",2)[PRCP("DPTYPE") S DIR(0)=DIR(0)_$P(X,";")_";"
  1.  S DIR("A")="Select FILE for inquiry"
  1.  W ! D ^DIR I Y'>444 Q
  1.  S PRCPFILE=+Y,PRCPPRIV=1
  1.  ;  file 445
  1.  I PRCPFILE=445 D  Q:$G(PRCPFLAG)
  1.  .   S XP="Do you want to see the inventory point parameters",XH="Enter YES to see the inventory point data, NO to just see item data, ^ to exit."
  1.  .   W ! S %=$$YN^PRCPUYN(2) I %'=1 S:%=0 PRCPFLAG=1 Q
  1.  .   W !?10,PRCP("RV1"),"*** I N V E N T O R Y   D A T A ***",PRCP("RV0")
  1.  .   N DA,DIC,DR
  1.  .   S DIC="^PRCP(445,",DA=PRCP("I"),DR="0;2;3;4;DEV"
  1.  .   D EN^DIQ
  1.  ;  file 445 and 445.1
  1.  I PRCPFILE=445!(PRCPFILE=445.1) D  Q
  1.  .   F  W ! S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") Q:'ITEMDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** I N V E N T O R Y   P O I N T   I T E M   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP("_PRCPFILE_","_PRCP("I")_",1,",DA=ITEMDA
  1.  .   .   D EN^DIQ
  1.  ;  file 445.2
  1.  I PRCPFILE=445.2 D  Q
  1.  .   F  W ! S TRANDA=$$SELECT^PRCPUTRS(PRCP("I")) Q:'TRANDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** T R A N S A C T I O N   R E G I S T E R   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(445.2,",DA=TRANDA
  1.  .   .   D EN^DIQ
  1.  ;  file 445.3
  1.  I PRCPFILE=445.3 D  Q
  1.  .   F  W ! S ORDERDA=$$ORDERSEL^PRCPOPUS(PRCP("I"),0,"*",0) Q:'ORDERDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** D I S T R I B U T I O N   O R D E R   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(445.3,",DA=ORDERDA
  1.  .   .   D EN^DIQ
  1.  ;  file 445.4
  1.  I PRCPFILE=445.4 D  Q
  1.  .   F  W ! S STOREDA=$$STORE^PRCPESTO(PRCP("I")) Q:'STOREDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** S T O R A G E   L O C A T I O N   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(445.4,",DA=STOREDA
  1.  .   .   D EN^DIQ
  1.  ;  file 445.6
  1.  I PRCPFILE=445.6 D  Q
  1.  .   F  W ! S GROUPDA=$$GROUP^PRCPEGRP(PRCP("I"),"") Q:'GROUPDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** G R O U P   C A T E G O R Y   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(445.6,",DA=GROUPDA
  1.  .   .   D EN^DIQ
  1.  ;  file 445.7
  1.  I PRCPFILE=445.7 D  Q
  1.  .   F  W ! S ITEMDA=$$SELECT^PRCPCED0("C",0,PRCP("I")) Q:'ITEMDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** C A S E   C A R T   I T E M   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(445.7,",DA=ITEMDA
  1.  .   .   D EN^DIQ
  1.  ;  file 445.8
  1.  I PRCPFILE=445.8 D  Q
  1.  .   F  W ! S ITEMDA=$$SELECT^PRCPCED0("K",0,PRCP("I")) Q:'ITEMDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** I N S T R U M E N T   K I T   I T E M   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(445.8,",DA=ITEMDA
  1.  .   .   D EN^DIQ
  1.  ;  file 446
  1.  I PRCPFILE=446 D  Q
  1.  .   F  W ! S COSTDA=$$SELCOSTS^PRCPUCC(PRCP("I")) Q:'COSTDA  D
  1.  .   .   W !?10,PRCP("RV1"),"*** D I S T R I B U T I O N   C O S T   D A T A ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(446,",DA=COSTDA
  1.  .   .   D EN^DIQ
  1.  ;  file 446.1
  1.  I PRCPFILE=446.1 D  Q
  1.  .   F  W ! S DATETIME=$$SELECT^PRCPUPAT Q:'DATETIME  D
  1.  .   .   W !?10,PRCP("RV1"),"*** P A T I E N T   D I S T R I B U T E D   S U P P L I E S ***",PRCP("RV0")
  1.  .   .   N DA,DIC,DR
  1.  .   .   S DIC="^PRCP(446.1,",DA=DATETIME
  1.  .   .   D EN^DIQ
  1.  Q
  1.  ;
  1.  ;
  1. FILES ;  list of files to select from
  1.  ;  filenumber:filename;inventory point type allowed
  1.  ;;445:GENERIC INVENTORY;WPS
  1.  ;;445.1:INVENTORY BALANCES;WPS
  1.  ;;445.2:INVENTORY TRANSACTION;WPS
  1.  ;;445.3:INTERNAL DISTRIBUTION ORDER;P
  1.  ;;445.4:STORAGE LOCATION;WPS
  1.  ;;445.6:GROUP CATEGORY;WPS
  1.  ;;445.7:CASE CARTS;PS
  1.  ;;445.8:INSTRUMENT KITS;PS
  1.  ;;446:DISTRIBUTION/USAGE HISTORY;WP
  1.  ;;446.1:INVENTORY DISTRIBUTED PATIENT SUPPLIES;PS