- 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
