ACHSVPS.m

ACHSVPS ; IHS/ITSC/PMF - VENDOR REPORT BY PHYSICIAN SPECIALITY ;  [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 D HOME^%ZIS,DT^DICRW

 N L,DIC,FLDS,BY,DHD

 S L=0,DIC="^AUTTVNDR(",FLDS="1103.01,1108,.01"

 S BY="1103.01;#,1108",DHD="VENDOR BY SPECIALITY & P.O. ISSUANCE DATE"

 D EN1^DIP

 I $$DIR^XBDIR("E","Press RETURN...")

 Q

 ;

LAD(DA,ACHSDATE) ;EP - Update LAST AUTH DATE in VENDOR.

 I '$$LOCK^ACHS("^AUTTVNDR(DA,0)","+") W:'$D(ZTQUEUED) *7,!,"LOCK at LAD^ACHSVPS failed.  NOTIFY PROGRAMMER." Q

 N DIE

 S DIE="^AUTTVNDR(",DR="1108///"_ACHSDATE

 D ^DIE

 I $$LOCK^ACHS("^AUTTVNDR(DA,0)","-")

 Q

 ;

OKC ;

 D HOME^%ZIS,DT^DICRW,^XBKVAR

 W !,"Updating LAST AUTH DATE in VENDOR file for Vendor Specialty Report..."

 N ACHSDATE,ACHSDIEN,ACHSPROV

 S ACHSPROV=9999999999

 F  S ACHSPROV=$O(^ACHSF(DUZ(2),"VB",ACHSPROV),-1) W "." Q:'(ACHSPROV=+ACHSPROV)  D

 . S ACHSDIEN=$O(^ACHSF(DUZ(2),"VB",ACHSPROV,999999999),-1)

 . Q:'ACHSDIEN

 . S ACHSDATE=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",1,0)),U)

 . Q:'ACHSDATE

 . D LAD^ACHSVPS(ACHSPROV,ACHSDATE)

 .Q

 W "DONE.",!

 Q

 ;

ACHSVPS   ; IHS/ITSC/PMF - VENDOR REPORT BY PHYSICIAN SPECIALITY ;  [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3        DO HOME^%ZIS

           DO DT^DICRW

 +4        NEW L,DIC,FLDS,BY,DHD

 +5        SET L=0

           SET DIC="^AUTTVNDR("

           SET FLDS="1103.01,1108,.01"

 +6        SET BY="1103.01;#,1108"

           SET DHD="VENDOR BY SPECIALITY & P.O. ISSUANCE DATE"

 +7        DO EN1^DIP

 +8        IF $$DIR^XBDIR("E","Press RETURN...")

 +9        QUIT 

 +10      ;

LAD(DA,ACHSDATE) ;EP - Update LAST AUTH DATE in VENDOR.

 +1        IF '$$LOCK^ACHS("^AUTTVNDR(DA,0)","+")

               IF '$DATA(ZTQUEUED)

                   WRITE *7,!,"LOCK at LAD^ACHSVPS failed.  NOTIFY PROGRAMMER."

               QUIT 

 +2        NEW DIE

 +3        SET DIE="^AUTTVNDR("

           SET DR="1108///"_ACHSDATE

 +4        DO ^DIE

 +5        IF $$LOCK^ACHS("^AUTTVNDR(DA,0)","-")

 +6        QUIT 

 +7       ;

OKC       ;

 +1        DO HOME^%ZIS

           DO DT^DICRW

           DO ^XBKVAR

 +2        WRITE !,"Updating LAST AUTH DATE in VENDOR file for Vendor Specialty Report..."

 +3        NEW ACHSDATE,ACHSDIEN,ACHSPROV

 +4        SET ACHSPROV=9999999999

 +5        FOR 

               SET ACHSPROV=$ORDER(^ACHSF(DUZ(2),"VB",ACHSPROV),-1)

               WRITE "."

               IF '(ACHSPROV=+ACHSPROV)

                   QUIT 

               Begin DoDot:1

 +6                SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"VB",ACHSPROV,999999999),-1)

 +7                IF 'ACHSDIEN

                       QUIT 

 +8                SET ACHSDATE=$PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",1,0)),U)

 +9                IF 'ACHSDATE

                       QUIT 

 +10               DO LAD^ACHSVPS(ACHSPROV,ACHSDATE)

 +11               QUIT 

               End DoDot:1

 +12       WRITE "DONE.",!

 +13       QUIT 

 +14      ;