ACHSDOCR ; IHS/ITSC/PMF - extract standard vars from 0 level of document [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
;standard call to fetch data. Pass in the document IEN, and
; get back a whole set of vars.
;
;INPUT:
; ACHSDIEN - the index number to the document
;
;OUTPUT:
; ACHSDOCR - the string from ACHSF(fac,"D",ACHSDIEN,0)
; OK - true if the process completed, otherwise false
;
;here are the variables that get returned, in alphabetical order
;in the software, they are set in the order of the ACHSDOCR string
;
; AMTOBLG total amount obligated
; BLNKT blanket order flag
; CAN CAN number
; CANP CAN number pointer
; CHART chart number
; CLERK clerk
; CNTRPTR contract pointer
; COMMENT comment
; DCRACCT dcr account number
; DESTN destination
; DRGRATE drg rate
; FAC facility code
; FSCLYR fiscal year of the doc
; IHSADJ HIS adjustments
; LSUP last supplement number
; LSTCNC last cancel number
; OCC object class code
; OCCPTR pointer to object class code
; ORDDAT order date
; ORDNUM order number
; PATNUM patient number
; SCC service class code
; SCCP service class code pointer
; STATUS status
; TRBPRN tribal purchase request number
; TRIBE tribal number
; TYPSER2 type of service encoded as 1/2/3
; TYPSERV type of service
; VNAGRPT vendor agreement pointer
; VNDEST vendor estimate
; VNDNAM vendor name
; VNDPTR vendor pointer
; VNDREF vendor reference number
;
S OK=0
I $G(ACHSDIEN)="" Q
;
S ACHSDOCR=$G(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
I ACHSDOCR="" Q
;
S ORDNUM=$P(ACHSDOCR,U,1)
S ORDDAT=$P(ACHSDOCR,U,2)
S BLNKT=$P(ACHSDOCR,U,3)
S TYPSERV=$P(ACHSDOCR,U,4),TYPSER2=$S(TYPSERV=1:43,TYPSERV=2:57,TYPSERV=3:64,1:" ")
;
S CNTRPTR=$P(ACHSDOCR,U,5)
;
S CANP=$P(ACHSDOCR,U,6),CAN="" I CANP'="" S CAN=$P($G(^ACHS(2,CANP,0)),U)
;
S SCCP=$P(ACHSDOCR,U,7),SCC="" I SCCP'="" S SCC=$P($G(^ACHS(3,DUZ(2),1,SCCP,0)),U)
;
S VNDPTR=$P(ACHSDOCR,U,8),VNDNAM="" I VNDPTR'="" S VNDNAM=$G(^AUTTVNDR(VNDPTR,0))
;
S AMTOBLG=$P(ACHSDOCR,U,9)
S OCCPTR=$P(ACHSDOCR,U,10),OCC="" I OCCPTR'="" S OCC=$P($G(^ACHSOCC(OCCPTR,0)),U)
;
S IHSADJ=$P(ACHSDOCR,U,11)
S STATUS=$P(ACHSDOCR,U,12)
S COMMENT=$P(ACHSDOCR,U,13)
S FSCLYR=$P(ACHSDOCR,U,14)
S LSTSUP=$P(ACHSDOCR,U,15)
S LSTCNC=$P(ACHSDOCR,U,16)
S DESTN=$P(ACHSDOCR,U,17)
S CLERK=$P(ACHSDOCR,U,18)
S DCRACCT=$P(ACHSDOCR,U,19)
S FAC=$P(ACHSDOCR,U,20)
S CHART=$P(ACHSDOCR,U,21)
S (DFN,PATNUM)=$P(ACHSDOCR,U,22)
S TRIBE=" "
I DFN'="" D
. S TRIBE=$P($G(^AUPNPAT(DFN,11)),U,8)
. I TRIBE'="" S TRIBE=$P($G(^AUTTTRI(TRIBE,0)),U,2)
. I TRIBE=""!(TRIBE'?3N) S TRIBE=" "
. Q
;
S VNAGPTR=$P(ACHSDOCR,U,23)
S VNDREFN=$P(ACHSDOCR,U,24)
S DRGRATE=$P(ACHSDOCR,U,25)
S TRBPRN=$P(ACHSDOCR,U,26)
S OK=1
;
Q
;
INIT ;
;init the vars to null
S (ACHSDOCR,AMTOBLG,BLNKT,CAN,CANP,CHART,CLERK,COMMENT)=""
S (CNTRPTR,FSCLYR,DCRACCT,DESTN,DRGRATE,FAC,IHSADJ,LSTSUP)=""
S (LSTCNC,OCC,OCCPTR,ORDDAT,ORDNUM,PATNUM,SCC,SCCP,STATUS)=""
S (TRBPRN,TRIBE,TYPSER2,TYPSERV,VNAGPTR,VNDEST,VNDPTR,VNDNAM,VNDREFN)=""
Q
;
KLL ;EP from ACHSTX11
;kill the vars normally set by this program
K ACHSDORC,AMTOBLG,BLNKT,CAN,CANP,CHART,CLERK,COMMENT
K CNTRPTR,FSCLYR,DCRACCT,DESTN,DRGRATE,FAC,IHSADJ,LSTSUP
K LSTCNC,OCC,OCCPTR,ORDDAT,ORDNUM,PATNUM,SCC,SCCP,STATUS
K TRBPRN,TRIBE,TYPSER2,TYPSERV,VNDEST,VNAGPTR,VNDPTR,VNDNAM,VNDREFN
Q
ACHSDOCR ; IHS/ITSC/PMF - extract standard vars from 0 level of document [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ;standard call to fetch data. Pass in the document IEN, and
+4 ; get back a whole set of vars.
+5 ;
+6 ;INPUT:
+7 ; ACHSDIEN - the index number to the document
+8 ;
+9 ;OUTPUT:
+10 ; ACHSDOCR - the string from ACHSF(fac,"D",ACHSDIEN,0)
+11 ; OK - true if the process completed, otherwise false
+12 ;
+13 ;here are the variables that get returned, in alphabetical order
+14 ;in the software, they are set in the order of the ACHSDOCR string
+15 ;
+16 ; AMTOBLG total amount obligated
+17 ; BLNKT blanket order flag
+18 ; CAN CAN number
+19 ; CANP CAN number pointer
+20 ; CHART chart number
+21 ; CLERK clerk
+22 ; CNTRPTR contract pointer
+23 ; COMMENT comment
+24 ; DCRACCT dcr account number
+25 ; DESTN destination
+26 ; DRGRATE drg rate
+27 ; FAC facility code
+28 ; FSCLYR fiscal year of the doc
+29 ; IHSADJ HIS adjustments
+30 ; LSUP last supplement number
+31 ; LSTCNC last cancel number
+32 ; OCC object class code
+33 ; OCCPTR pointer to object class code
+34 ; ORDDAT order date
+35 ; ORDNUM order number
+36 ; PATNUM patient number
+37 ; SCC service class code
+38 ; SCCP service class code pointer
+39 ; STATUS status
+40 ; TRBPRN tribal purchase request number
+41 ; TRIBE tribal number
+42 ; TYPSER2 type of service encoded as 1/2/3
+43 ; TYPSERV type of service
+44 ; VNAGRPT vendor agreement pointer
+45 ; VNDEST vendor estimate
+46 ; VNDNAM vendor name
+47 ; VNDPTR vendor pointer
+48 ; VNDREF vendor reference number
+49 ;
+50 SET OK=0
+51 IF $GET(ACHSDIEN)=""
QUIT
+52 ;
+53 SET ACHSDOCR=$GET(^ACHSF(DUZ(2),"D",ACHSDIEN,0))
+54 IF ACHSDOCR=""
QUIT
+55 ;
+56 SET ORDNUM=$PIECE(ACHSDOCR,U,1)
+57 SET ORDDAT=$PIECE(ACHSDOCR,U,2)
+58 SET BLNKT=$PIECE(ACHSDOCR,U,3)
+59 SET TYPSERV=$PIECE(ACHSDOCR,U,4)
SET TYPSER2=$SELECT(TYPSERV=1:43,TYPSERV=2:57,TYPSERV=3:64,1:" ")
+60 ;
+61 SET CNTRPTR=$PIECE(ACHSDOCR,U,5)
+62 ;
+63 SET CANP=$PIECE(ACHSDOCR,U,6)
SET CAN=""
IF CANP'=""
SET CAN=$PIECE($GET(^ACHS(2,CANP,0)),U)
+64 ;
+65 SET SCCP=$PIECE(ACHSDOCR,U,7)
SET SCC=""
IF SCCP'=""
SET SCC=$PIECE($GET(^ACHS(3,DUZ(2),1,SCCP,0)),U)
+66 ;
+67 SET VNDPTR=$PIECE(ACHSDOCR,U,8)
SET VNDNAM=""
IF VNDPTR'=""
SET VNDNAM=$GET(^AUTTVNDR(VNDPTR,0))
+68 ;
+69 SET AMTOBLG=$PIECE(ACHSDOCR,U,9)
+70 SET OCCPTR=$PIECE(ACHSDOCR,U,10)
SET OCC=""
IF OCCPTR'=""
SET OCC=$PIECE($GET(^ACHSOCC(OCCPTR,0)),U)
+71 ;
+72 SET IHSADJ=$PIECE(ACHSDOCR,U,11)
+73 SET STATUS=$PIECE(ACHSDOCR,U,12)
+74 SET COMMENT=$PIECE(ACHSDOCR,U,13)
+75 SET FSCLYR=$PIECE(ACHSDOCR,U,14)
+76 SET LSTSUP=$PIECE(ACHSDOCR,U,15)
+77 SET LSTCNC=$PIECE(ACHSDOCR,U,16)
+78 SET DESTN=$PIECE(ACHSDOCR,U,17)
+79 SET CLERK=$PIECE(ACHSDOCR,U,18)
+80 SET DCRACCT=$PIECE(ACHSDOCR,U,19)
+81 SET FAC=$PIECE(ACHSDOCR,U,20)
+82 SET CHART=$PIECE(ACHSDOCR,U,21)
+83 SET (DFN,PATNUM)=$PIECE(ACHSDOCR,U,22)
+84 SET TRIBE=" "
+85 IF DFN'=""
Begin DoDot:1
+86 SET TRIBE=$PIECE($GET(^AUPNPAT(DFN,11)),U,8)
+87 IF TRIBE'=""
SET TRIBE=$PIECE($GET(^AUTTTRI(TRIBE,0)),U,2)
+88 IF TRIBE=""!(TRIBE'?3N)
SET TRIBE=" "
+89 QUIT
End DoDot:1
+90 ;
+91 SET VNAGPTR=$PIECE(ACHSDOCR,U,23)
+92 SET VNDREFN=$PIECE(ACHSDOCR,U,24)
+93 SET DRGRATE=$PIECE(ACHSDOCR,U,25)
+94 SET TRBPRN=$PIECE(ACHSDOCR,U,26)
+95 SET OK=1
+96 ;
+97 QUIT
+98 ;
INIT ;
+1 ;init the vars to null
+2 SET (ACHSDOCR,AMTOBLG,BLNKT,CAN,CANP,CHART,CLERK,COMMENT)=""
+3 SET (CNTRPTR,FSCLYR,DCRACCT,DESTN,DRGRATE,FAC,IHSADJ,LSTSUP)=""
+4 SET (LSTCNC,OCC,OCCPTR,ORDDAT,ORDNUM,PATNUM,SCC,SCCP,STATUS)=""
+5 SET (TRBPRN,TRIBE,TYPSER2,TYPSERV,VNAGPTR,VNDEST,VNDPTR,VNDNAM,VNDREFN)=""
+6 QUIT
+7 ;
KLL ;EP from ACHSTX11
+1 ;kill the vars normally set by this program
+2 KILL ACHSDORC,AMTOBLG,BLNKT,CAN,CANP,CHART,CLERK,COMMENT
+3 KILL CNTRPTR,FSCLYR,DCRACCT,DESTN,DRGRATE,FAC,IHSADJ,LSTSUP
+4 KILL LSTCNC,OCC,OCCPTR,ORDDAT,ORDNUM,PATNUM,SCC,SCCP,STATUS
+5 KILL TRBPRN,TRIBE,TYPSER2,TYPSERV,VNDEST,VNAGPTR,VNDPTR,VNDNAM,VNDREFN
+6 QUIT
