- ACHSAL ; IHS/ITSC/PMF - SPECIAL LOCAL OBLIGATION HEADER/DRIVER ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- ;
- ;this program is the kickoff point for the creation of
- ;special obligation documents
- A1 ;
- S ACHSSLOC="",ACHSACWK=ACHSFYWK(DUZ(2),ACHSCFY)
- I $D(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",ACHSACWK,0)),$P($G(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",ACHSACWK,0)),U,2)=DT W !!,*7," The Register Has Been CLOSED." S %=$$DIR^XBDIR("E") G END
- ;
- ;INIT VARS
- S (ACHSBLT,ACHSCAN,ACHSCONP,ACHSCOPT,ACHSDCR,ACHSDES,ACHSDEST)=""
- S (ACHSESDA,ACHSESDO,ACHSFDT,ACHSHON,ACHSHONN,ACHSORND)=""
- S (ACHSPROV,ACHSRMPC,ACHSSCC,ACHSSVDT,ACHSTDT,ACHSTYP,ACHSWKLD)=""
- ;
- K DFN
- S ACHSBLT="SPECIAL TRANSACTION"
- D ^ACHSA
- I '$D(DUOUT),'$D(DTOUT) G A1
- END ;
- K DUOUT,B
- D EN^XBVK("ACHS"),^ACHSVAR
- Q
- ;
- ACHSAL ; IHS/ITSC/PMF - SPECIAL LOCAL OBLIGATION HEADER/DRIVER ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- +3 ;
- +4 ;this program is the kickoff point for the creation of
- +5 ;special obligation documents
- A1 ;
- +1 SET ACHSSLOC=""
- SET ACHSACWK=ACHSFYWK(DUZ(2),ACHSCFY)
- +2 IF $DATA(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",ACHSACWK,0))
- IF $PIECE($GET(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",ACHSACWK,0)),U,2)=DT
- WRITE !!,*7," The Register Has Been CLOSED."
- SET %=$$DIR^XBDIR("E")
- GOTO END
- +3 ;
- +4 ;INIT VARS
- +5 SET (ACHSBLT,ACHSCAN,ACHSCONP,ACHSCOPT,ACHSDCR,ACHSDES,ACHSDEST)=""
- +6 SET (ACHSESDA,ACHSESDO,ACHSFDT,ACHSHON,ACHSHONN,ACHSORND)=""
- +7 SET (ACHSPROV,ACHSRMPC,ACHSSCC,ACHSSVDT,ACHSTDT,ACHSTYP,ACHSWKLD)=""
- +8 ;
- +9 KILL DFN
- +10 SET ACHSBLT="SPECIAL TRANSACTION"
- +11 DO ^ACHSA
- +12 IF '$DATA(DUOUT)
- IF '$DATA(DTOUT)
- GOTO A1
- END ;
- +1 KILL DUOUT,B
- +2 DO EN^XBVK("ACHS")
- DO ^ACHSVAR
- +3 QUIT
- +4 ;
