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

ACHSYPQ.m

Go to the documentation of this file. 
  1. ACHSYPQ ; IHS/ITSC/PMF - SET DOCUMENTS INTO PRINT QUE ;   [ 03/07/2002  10:45 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3,19**;JUN 11, 2001
  1.  ;ACHS*3.1*3  change method of getting transaction method
  1.  ;            also, start at the right document
  1.  ;
  1.  ; This utility sets document IENs into the "PQ" x-ref, which is used
  1.  ; for batch printing of documents.
  1.  ;
  1.  ; Kernel variables must be defined.
  1.  ;
  1.  ; You will be asked for the beginning internal entry number.
  1.  ;
  1.  ; The entire file can be x-ref'd using FM x-ref utility, CHS FACILITY
  1.  ; file, DOCUMENT sub-file, TRANSACTION sub-file, TRANSACTION TYPE
  1.  ; field, "PQ" x-ref.
  1.  ;
  1.  ;THIS HAS BEEN RESTRUCTURED AND RE-WRITTEN AS THE ORIGINAL WAS NOT
  1.  ;WORKING
  1.  ;
  1.  ;ACHS*3.1*19 CHANGED THE PROMPT TO REQUEST FY AND DOCUMENT NUMBER AND ENDING DOCUMENT NUMBER
  1.  ;
  1.  S U="^"
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." Q
  1.  I '$G(DUZ(2)) W !,"DUZ(2) UNDEFINED OR 0." Q
  1.  D HOME^%ZIS,DT^DICRW
  1.  W @IOF
  1.  W !,"This option will reset PO's to be printed.  You will need to enter the FY "
  1.  W !,"and starting and ending PO number.  Use the print document option to print PO's.",!
  1. START ;
  1. FY ;ENTER FY FOR START OF DOCUMENT RESET
  1.  S ACHSSFY=ACHSCFY-10
  1.  S DIR(0)="N^"_ACHSSFY_":"_ACHSCFY,DIR("A")="Enter the 4 digit FY for starting document"
  1.  S DIR("B")=ACHSCFY
  1.  D ^DIR K DIR
  1.  G:$D(DIRUT) EXT
  1.  G:Y<1 START
  1.  S ACHSEFY=Y
  1. DOC ;ENTER STARTING DOCUMENT NUMBER
  1.  S DIR(0)="N^1:"_$P(^ACHS(9,DUZ(2),"FY",ACHSEFY,"C"),U),DIR("A")="Enter the starting document number"
  1.  D ^DIR K DIR
  1.  G:$D(DIRUT) EXT
  1.  G:Y<1 START
  1.  S ACHSDOCS=Y
  1. EDOC ;ENTER ENDING DOCUMENT NUMBER
  1.  S DIR(0)="N^"_ACHSDOCS_":"_$P(^ACHS(9,DUZ(2),"FY",ACHSEFY,"C"),U),DIR("A")="Enter the ending document number"
  1.  D ^DIR K DIR
  1.  G:$D(DIRUT) EXT
  1.  G:Y<1 START
  1.  S ACHSDOCE=Y
  1.  ;S Y=$$DIR^XBDIR("NO^1:"_$P($G(^ACHSF(DUZ(2),"D",0)),U,3),"ENTER BEGINNING IEN")
  1.  ;Q:$D(DUOUT)!$D(DTOUT)
  1.  ;Q:'Y
  1.  W !
  1.  N C,D,N,P,S,O,T
  1.  ;
  1.  ;S DOCUMENT=0  ;  ACHS*3.1*3
  1.  ;S DOCUMENT=Y-1
  1. BEIN ;FIND BEG EIN
  1.  S DOCUMENT=0
  1.  S ACHSDOC=1_$E(ACHSEFY,4)_"00000"+ACHSDOCS
  1.  S DOCUMENT=$O(^ACHSF(DUZ(2),"D","B",ACHSDOC,DOCUMENT))
  1.  S DOCUMENT=DOCUMENT-1
  1. EEIN ;FIND END EIN
  1.  S LASTEIN=0
  1.  S ACHSDOC=1_$E(ACHSEFY,4)_"00000"+ACHSDOCE
  1.  S LASTEIN=$O(^ACHSF(DUZ(2),"D","B",ACHSDOC,LASTEIN))
  1.  ;
  1.  S O(6)=$P($G(^ACHSF(DUZ(2),2)),U,6)="Y"  ;PRINT CANCEL DOCUMENTS
  1.  S O(7)=$P($G(^ACHSF(DUZ(2),2)),U,7)="Y"  ;PRINT SUPPLEMENTAL DOCUMENTS
  1.  W !
  1.  S DX=$X,DY=$Y,C=0
  1.  ;S LASTIEN=$P($G(^ACHSF(DUZ(2),"D",0)),U,4) ;GET LAST ENTRY # USED
  1. GO ;
  1.  F  S DOCUMENT=$O(^ACHSF(DUZ(2),"D",DOCUMENT)) Q:(DOCUMENT'?1N.N)!(DOCUMENT>LASTEIN)  D
  1.  .;
  1.  .Q:$P(^ACHSF(DUZ(2),"D",DOCUMENT,0),U,27)'=ACHSEFY
  1.  .S TYPESERV=$P($G(^ACHSF(DUZ(2),"D",DOCUMENT,0)),U,4)
  1.  .Q:TYPESERV=""
  1.  .W "."
  1.  .;
  1.  .;S TRANSNUM=$P($G(^ACHSF(DUZ(2),"D",DOCUMENT,"T",0)),U,3)  ;GET LAST TRANSACTION NUMBER USED  ;  ACHS*3.1*3
  1.  .S TRANSNUM=$O(^ACHSF(DUZ(2),"D",DOCUMENT,"T",""),-1) I 'TRANSNUM Q
  1.  .;
  1.  .S TRANTYPE=$P($G(^ACHSF(DUZ(2),"D",DOCUMENT,"T",TRANSNUM,0)),U,2)
  1.  .Q:TRANTYPE'="I"&(TRANTYPE'="C")&(TRANTYPE'="S")
  1.  .Q:TRANTYPE="C"&('O(6))
  1.  .Q:TRANTYPE="S"&('O(7))
  1.  .S ^ACHSF("PQ",DUZ(2),TYPESERV,DOCUMENT,TRANSNUM)=""
  1.  Q
  1. EXT ;
  1.  K ACHSDOCS,ACHSDOCE,ACHSEFY,DOCUMENT,TRANSNUM,TYPESERV,LASTEIN
  1.  ;