APSSINI0 ;IHS/CIA/MDM - ScriptPro Interface;26-Jun-2008 15:01;DU
;;1.0;IHS SCRIPTPRO INTERFACE;**1**;January 11, 2006
; APSS COMMAND FILE (#9009033.3) Maintenance & Initialization routine
; Direct entry not supported
Q
EP1 ;MDM - Main entry point
;
; File structure
; APSS COMMAND FILE (#9009033.3)
; APSS COMMAND FILE DATA TAG (Multiple-9009033.31)
; APSS COMMAND FILE DATA TAG DESCRIPTION (Multiple-9009033.312)
;
; Variable definitions
; APSSDAT = Data
; APSSCLC = Comment Line count
; APSSTAG = Data Tag (.01)
; APSSSEQ = Sequence (.02)
; APSSFLD = File/Field (.03)
; APSSFMT = Format (.04)
; APSSTRAN = Transform (1)
; APSSDESC = Description total line number (2)
; APSSCMD = Command
; APSSSIEN = DATA TAG Subfile IEN
; APSSIEN = FDA Array FDA_ROOT Construct
; APSSDIEN = DATA TAG DESCRIPTION Sub-Sub File Word Processing field IEN
; APSSLINE = Description Text line being processed (Reading data statements)
; APSSDEND = Description Text Ending line number (Reading data statements)
; APSSDBEG = Description Text Beginning line number (Reading data statements)
; ACTION = What action took place (ADD, EDIT, DELETE)
; APSSUTAG = Original value that was modified
;
; Initialize working variables and control cleanup upon routine termination
N APSSDAT,APSSCLC,APSSTAG,APSSSEQ,APSSFLD,APSSFMT,APSSDESC,APSSTRAN,APSSUTAG
N APSSCMD,APSSSIEN,APSSIEN,APSSDIEN,FDA,APSSDEND,APSSDBEG,APSSLINE,ACTION
N ARY,SSEQ
;
; Grab the IEN for the FILL Command
S APSSCMD="",APSSCMD=$O(^APSSCOMD("B","FILL",APSSCMD)) Q:'APSSCMD
S SIEN=0 F S SIEN=$O(^APSSCOMD(APSSCMD,1,SIEN)) Q:'SIEN D
.S SSEQ=$P($G(^APSSCOMD(APSSCMD,1,SIEN,0)),U,2)
.I SSEQ S ARY(SSEQ)=$P(^APSSCOMD(APSSCMD,1,SIEN,0),U,1)
;
; MAIN PROCESSING LOOP
; Loop through the data statement section of this routine
F APSSCLC=1:1 S APSSDAT=$P($T(DATA+APSSCLC),";",2) Q:APSSDAT="EOD" D
. ; If there is no data on that line quit processing and go get the next line
. I APSSDAT="" Q
. ; If the line does not have a "^" in it then it is an invalid record so quit.
. I APSSDAT'["^" Q
. ; Piece out the major data elements
. S APSSTAG=$P(APSSDAT,"^",1) ; Data Tag
. S APSSSEQ=$P(APSSDAT,"^",2) ; Sequence
. ; if the sequence number is in use and the data tag does not match what is being delivered
. ; change this sequence number
. I $D(ARY(APSSSEQ))&($G(ARY(APSSSEQ))'=APSSTAG) S APSSSEQ=$$NEWSEQ(.ARY,APSSSEQ)
. S APSSFLD=$P(APSSDAT,"^",3) ; File/Field
. S APSSFMT=$P($P(APSSDAT,"^",4),"~",1) ; Format
. S APSSTRAN=$P(APSSDAT,"~",2) ; Transform
. S APSSDESC=$P(APSSDAT,"~",3) ; Description
. ;
. ; Filing methods and requirements are determined in this section of code.
. ;
. ; *****************************DELETE**************************************
. ; Check for delete flag and if present, perform appropriate action.
. I APSSTAG["@",$D(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"@",2))) D Q
. . W !,"DELETE RECORD"
. . S ACTION="DELETE"
. . ; Grab the IEN for this Data Tag
. . S APSSSIEN="",APSSSIEN=$O(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"@",2),APSSSIEN))
. . ; Build FDA Array IEN Construct
. . S APSSIEN=APSSSIEN_","_APSSCMD_","
. . ; Build FDA Array to define file structure and field values
. . S FDA(9009033.31,APSSIEN,.01)="@"
. . ;
. . ; Delete this record in the file
. . D FILE^DIE("","FDA","ERR")
. . ;
. . I +$G(ERR("ERR")) D RESET Q
. . ;
. . ; Display informational message
. . D MSG
. . ; DEVELOPEMENT DISPLAY
. . ;D DISP
. . ; Reset working variables
. . D RESET
. . ;
. . Q
. ;
. ; *****************************UPDATE***************************************
. ; If the Umlaut is found in the APSSTAG string then,
. ; Check for an existing entry and if present, perform appropriate action.
. ;I APSSTAG["`",$D(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"`",1))) D Q
. I $D(^APSSCOMD(APSSCMD,1,"B",APSSTAG)) D Q
. . W !,"UPDATE RECORD"
. . S ACTION="EDIT"
. . ; Strip off the umlaut character and separate the two values
. . ; If the DATA TAG value is changing them Piece 2 holds the new value
. . S APSSUTAG=$P(APSSTAG,"`",2)
. . ; Piece one holds the current value
. . S APSSTAG=$P(APSSTAG,"`",1)
. . ; If piece 1 has no value then
. . ; Data in another field is changing but the DATA TAG field is not changing
. . I APSSTAG="" S APSSTAG=APSSUTAG
. . ; Grab the IEN for this Data Tag
. . S APSSSIEN="",APSSSIEN=$O(^APSSCOMD(APSSCMD,1,"B",APSSTAG,APSSSIEN))
. . ; Build FDA Array IEN Construct
. . S APSSIEN=APSSSIEN_","_APSSCMD_","
. . ; Build FDA Array
. . D FDA
. . ;
. . ; Update the file
. . D FILE^DIE("","FDA","ERR")
. . ;
. . I +$G(ERR("ERR")) D RESET Q
. . ;
. . ; Display informational message
. . D MSG
. . ; Process Description Text if defined
. . D DESC(APSSSIEN)
. . ; DEVELOPEMENT DISPLAY
. . ;D DISP
. . ; Reset working variables
. . D RESET
. . Q
. ;
. ; **************************NEW ENTRY***************************************
. ; File a new entry
. ; Check for an existing entry and if NOT present, perform appropriate action.
. I '$D(^APSSCOMD(APSSCMD,1,"B",APSSTAG)) D Q
. . W !,"RECORD NEW ENTRY"
. . S ACTION="ADD"
. . S APSSSIEN="+1"
. . ; Build FDA Array IEN Construct
. . S APSSIEN=APSSSIEN_","_APSSCMD_","
. . ; Build FDA Array
. . D FDA
. . ;
. . ; File the Data
. . D UPDATE^DIE("","FDA","ERR")
. . ;
. . I +$G(ERR("ERR")) D RESET Q
. . ;
. . ;Display informational message
. . D MSG
. . ; Process Description Text if defined
. . D DESC(ERR(1))
. . ; DEVELOPEMENT DISPLAY
. . ;D DISP
. . ; Reset working variables
. . D RESET
. . Q
. Q
;
; Kill the message arrays and variables that are produced by VA FileMan.
D CLEAN^DILF
; End of processing
Q
DESC(REC) ; Process description text and put it into the file
; If there is no description text then quit
I 'APSSDESC Q
S APSSIEN=REC_","_APSSCMD_","
; Process Description text data statements
S APSSDEND=APSSCLC+APSSDESC,APSSDBEG=APSSCLC+1 ; Initialize counters
; Loop through the description text for this data tag
F APSSLINE=APSSDBEG:1:APSSDEND S APSSDAT=$P($T(DATA+APSSLINE),";",2) D
. ; Set up data array t be processed by VA Fileman.
. S TMP("WP",APSSLINE)=APSSDAT,APSSDAT=""
. Q
;
; If Description lines were defined then adjust process looping position
; and send the data to VA Fileman to put into the database.
I APSSLINE S APSSCLC=APSSLINE,APSSLINE="" D
. ;
. ; File the description text
. D WP^DIE(9009033.31,APSSIEN,2,"K","TMP(""WP"")","ERR(""WP"")")
. Q
;
Q
FDA ;
; Build FDA Array to define file structure and field values for use by Fileman
S FDA(9009033.31,APSSIEN,.01)=APSSTAG
I $G(APSSUTAG)]"" S FDA(9009033.31,APSSIEN,.01)=APSSUTAG
S FDA(9009033.31,APSSIEN,.02)=APSSSEQ
S FDA(9009033.31,APSSIEN,.03)=APSSFLD
S FDA(9009033.31,APSSIEN,.04)=APSSFMT
S FDA(9009033.31,APSSIEN,1)=APSSTRAN
Q
RESET ;
; Reset working variables to NULL once each record is processed
S APSSTAG="" ; Data Tag
S APSSSEQ="" ; Sequence
S APSSFLD="" ; File/Field
S APSSFMT="" ; Format
S APSSTRAN="" ; Transform
S APSSDESC="" ; Description
K TMP,FDA,ERR,ACTION,APSSUTAG
Q
MSG ; Set up informational messages to display to the screen
;
I '$G(ERR) D
. I ACTION="ADD" D MES("Data Record: "_APSSTAG_" has been ADDED.")
. I ACTION="DELETE" D MES("Data Record: "_$P(APSSTAG,"@",2)_" has been DELETED.")
. I ACTION="EDIT" D MES("Data Record: "_$P(APSSTAG,"`",1)_" has been MODIFIED.")
. Q
E D MES("Data Field: "_APSSTAG_" resulted in ERROR "_ERR(1))
Q
MES(MSG,QUIT) ; Display informational messages
D BMES^XPDUTL(" "_$G(MSG))
Q
; INPUT ARRAY - List of current sequence numbers being used at the facility
; SQ - Sequence number needing to be changed.
;
NEWSEQ(ARRAY,SQ) ;
N OFFSET,QUIT,NSQ
S QUIT=0,NSQ=SQ
F OFFSET=.1:.1:.9 D Q:QUIT
.S NSQ=$P(SQ,".")+OFFSET
.I '$D(ARRAY(NSQ)) S QUIT=1 Q
I 'QUIT S NSQ=SQ+.01
Q NSQ
; *************************************************************************
; Structure of data statements found below the DATA line tag.
;
; DATA TAG^SEQUENCE^FILE,FIELD^FORMAT~TRANSFORM~NUMBER OF DESC. TEXT LINES
; NOTE:
; If there is a number in the last "~" piece then, there is description text
; which may be multiple lines of text. That text will follow the data line
; and preceed the next data line. The FOR loop reading the data statements
; will be adjusted to skip over the description text. A secondary loop will
; read and process the description data.
;
; To delete a record an "@" must appear as the first character of the data
; string.
;
; To modify a record use the Umlaut "`" as a flag in the first piece of the
; data string indicating it is an update. If the first "^" piece is to be
; modified then the NEW value must appear in the SECOND "`" piece.
;
DATA ; This module holds the data that will be put into the database.
;
;Patient Gender^3.2^2,.02^Z~S VAL=$$GET1^DIQ(2,$P(RX0,U,2),.02)~1
;Patient Gender Designator
;Patient Address^3.3^^Z~S VAL=$$PADDR^APSSLIC($P(RX0,U,2))~1
;Patient Address
;Provider Class^31^200,53.5^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.5)~1
;Provider Class
;Provider DEA#^32^200,53.2^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.2)~1
;Provider DEA#
;Site DEA#^33^^Z~S VAL=$$SDEA^APSSLIC($P(RX0,U,5))~1
;Site DEA#
;Site Name^34^^Z~S VAL=$$SNAME^APSSLIC($P(RX0,U,5))~1
;Site Name
;Issue Date^35^52,1^Z~S VAL=$$FMTE^XLFDT($P(RX0,U,13),"5Z")~1
;Issue Date
;Login Date^37^52,21^Z~S VAL=$$FMTE^XLFDT($P(RX2,U),"5Z")~1
;Login Date
;License Number^36^200.541,1^ZR~S VAL=$$EP1^APSSLIC($$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I"),2)~17
;Provider License Number
;
; Parameter 1 passed to APSSLIC routine represents the Provider Internal Entry Number
; Paramneter 2 represents the processing method which is described below..
;
; Method 1
; Match it to the state the facility is in
; If there is no license for that state then return any valid license
; If no valid license found for any state then return NULL
;
; Method 2
; There is no license for the state the facility is in then,
; return NULL even if other states have a valid license defined.
;
; Method 3
; Return first valid license found regardless of state
; No valid license found, then return NULL
;
;EOD
Q
APSSINI0 ;IHS/CIA/MDM - ScriptPro Interface;26-Jun-2008 15:01;DU
+1 ;;1.0;IHS SCRIPTPRO INTERFACE;**1**;January 11, 2006
+2 ; APSS COMMAND FILE (#9009033.3) Maintenance & Initialization routine
+3 ; Direct entry not supported
+4 QUIT
EP1 ;MDM - Main entry point
+1 ;
+2 ; File structure
+3 ; APSS COMMAND FILE (#9009033.3)
+4 ; APSS COMMAND FILE DATA TAG (Multiple-9009033.31)
+5 ; APSS COMMAND FILE DATA TAG DESCRIPTION (Multiple-9009033.312)
+6 ;
+7 ; Variable definitions
+8 ; APSSDAT = Data
+9 ; APSSCLC = Comment Line count
+10 ; APSSTAG = Data Tag (.01)
+11 ; APSSSEQ = Sequence (.02)
+12 ; APSSFLD = File/Field (.03)
+13 ; APSSFMT = Format (.04)
+14 ; APSSTRAN = Transform (1)
+15 ; APSSDESC = Description total line number (2)
+16 ; APSSCMD = Command
+17 ; APSSSIEN = DATA TAG Subfile IEN
+18 ; APSSIEN = FDA Array FDA_ROOT Construct
+19 ; APSSDIEN = DATA TAG DESCRIPTION Sub-Sub File Word Processing field IEN
+20 ; APSSLINE = Description Text line being processed (Reading data statements)
+21 ; APSSDEND = Description Text Ending line number (Reading data statements)
+22 ; APSSDBEG = Description Text Beginning line number (Reading data statements)
+23 ; ACTION = What action took place (ADD, EDIT, DELETE)
+24 ; APSSUTAG = Original value that was modified
+25 ;
+26 ; Initialize working variables and control cleanup upon routine termination
+27 NEW APSSDAT,APSSCLC,APSSTAG,APSSSEQ,APSSFLD,APSSFMT,APSSDESC,APSSTRAN,APSSUTAG
+28 NEW APSSCMD,APSSSIEN,APSSIEN,APSSDIEN,FDA,APSSDEND,APSSDBEG,APSSLINE,ACTION
+29 NEW ARY,SSEQ
+30 ;
+31 ; Grab the IEN for the FILL Command
+32 SET APSSCMD=""
SET APSSCMD=$ORDER(^APSSCOMD("B","FILL",APSSCMD))
IF 'APSSCMD
QUIT
+33 SET SIEN=0
FOR
SET SIEN=$ORDER(^APSSCOMD(APSSCMD,1,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+34 SET SSEQ=$PIECE($GET(^APSSCOMD(APSSCMD,1,SIEN,0)),U,2)
+35 IF SSEQ
SET ARY(SSEQ)=$PIECE(^APSSCOMD(APSSCMD,1,SIEN,0),U,1)
End DoDot:1
+36 ;
+37 ; MAIN PROCESSING LOOP
+38 ; Loop through the data statement section of this routine
+39 FOR APSSCLC=1:1
SET APSSDAT=$PIECE($TEXT(DATA+APSSCLC),";",2)
IF APSSDAT="EOD"
QUIT
Begin DoDot:1
+40 ; If there is no data on that line quit processing and go get the next line
+41 IF APSSDAT=""
QUIT
+42 ; If the line does not have a "^" in it then it is an invalid record so quit.
+43 IF APSSDAT'["^"
QUIT
+44 ; Piece out the major data elements
+45 ; Data Tag
SET APSSTAG=$PIECE(APSSDAT,"^",1)
+46 ; Sequence
SET APSSSEQ=$PIECE(APSSDAT,"^",2)
+47 ; if the sequence number is in use and the data tag does not match what is being delivered
+48 ; change this sequence number
+49 IF $DATA(ARY(APSSSEQ))&($GET(ARY(APSSSEQ))'=APSSTAG)
SET APSSSEQ=$$NEWSEQ(.ARY,APSSSEQ)
+50 ; File/Field
SET APSSFLD=$PIECE(APSSDAT,"^",3)
+51 ; Format
SET APSSFMT=$PIECE($PIECE(APSSDAT,"^",4),"~",1)
+52 ; Transform
SET APSSTRAN=$PIECE(APSSDAT,"~",2)
+53 ; Description
SET APSSDESC=$PIECE(APSSDAT,"~",3)
+54 ;
+55 ; Filing methods and requirements are determined in this section of code.
+56 ;
+57 ; *****************************DELETE**************************************
+58 ; Check for delete flag and if present, perform appropriate action.
+59 IF APSSTAG["@"
IF $DATA(^APSSCOMD(APSSCMD,1,"B",$PIECE(APSSTAG,"@",2)))
Begin DoDot:2
+60 WRITE !,"DELETE RECORD"
+61 SET ACTION="DELETE"
+62 ; Grab the IEN for this Data Tag
+63 SET APSSSIEN=""
SET APSSSIEN=$ORDER(^APSSCOMD(APSSCMD,1,"B",$PIECE(APSSTAG,"@",2),APSSSIEN))
+64 ; Build FDA Array IEN Construct
+65 SET APSSIEN=APSSSIEN_","_APSSCMD_","
+66 ; Build FDA Array to define file structure and field values
+67 SET FDA(9009033.31,APSSIEN,.01)="@"
+68 ;
+69 ; Delete this record in the file
+70 DO FILE^DIE("","FDA","ERR")
+71 ;
+72 IF +$GET(ERR("ERR"))
DO RESET
QUIT
+73 ;
+74 ; Display informational message
+75 DO MSG
+76 ; DEVELOPEMENT DISPLAY
+77 ;D DISP
+78 ; Reset working variables
+79 DO RESET
+80 ;
+81 QUIT
End DoDot:2
QUIT
+82 ;
+83 ; *****************************UPDATE***************************************
+84 ; If the Umlaut is found in the APSSTAG string then,
+85 ; Check for an existing entry and if present, perform appropriate action.
+86 ;I APSSTAG["`",$D(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"`",1))) D Q
+87 IF $DATA(^APSSCOMD(APSSCMD,1,"B",APSSTAG))
Begin DoDot:2
+88 WRITE !,"UPDATE RECORD"
+89 SET ACTION="EDIT"
+90 ; Strip off the umlaut character and separate the two values
+91 ; If the DATA TAG value is changing them Piece 2 holds the new value
+92 SET APSSUTAG=$PIECE(APSSTAG,"`",2)
+93 ; Piece one holds the current value
+94 SET APSSTAG=$PIECE(APSSTAG,"`",1)
+95 ; If piece 1 has no value then
+96 ; Data in another field is changing but the DATA TAG field is not changing
+97 IF APSSTAG=""
SET APSSTAG=APSSUTAG
+98 ; Grab the IEN for this Data Tag
+99 SET APSSSIEN=""
SET APSSSIEN=$ORDER(^APSSCOMD(APSSCMD,1,"B",APSSTAG,APSSSIEN))
+100 ; Build FDA Array IEN Construct
+101 SET APSSIEN=APSSSIEN_","_APSSCMD_","
+102 ; Build FDA Array
+103 DO FDA
+104 ;
+105 ; Update the file
+106 DO FILE^DIE("","FDA","ERR")
+107 ;
+108 IF +$GET(ERR("ERR"))
DO RESET
QUIT
+109 ;
+110 ; Display informational message
+111 DO MSG
+112 ; Process Description Text if defined
+113 DO DESC(APSSSIEN)
+114 ; DEVELOPEMENT DISPLAY
+115 ;D DISP
+116 ; Reset working variables
+117 DO RESET
+118 QUIT
End DoDot:2
QUIT
+119 ;
+120 ; **************************NEW ENTRY***************************************
+121 ; File a new entry
+122 ; Check for an existing entry and if NOT present, perform appropriate action.
+123 IF '$DATA(^APSSCOMD(APSSCMD,1,"B",APSSTAG))
Begin DoDot:2
+124 WRITE !,"RECORD NEW ENTRY"
+125 SET ACTION="ADD"
+126 SET APSSSIEN="+1"
+127 ; Build FDA Array IEN Construct
+128 SET APSSIEN=APSSSIEN_","_APSSCMD_","
+129 ; Build FDA Array
+130 DO FDA
+131 ;
+132 ; File the Data
+133 DO UPDATE^DIE("","FDA","ERR")
+134 ;
+135 IF +$GET(ERR("ERR"))
DO RESET
QUIT
+136 ;
+137 ;Display informational message
+138 DO MSG
+139 ; Process Description Text if defined
+140 DO DESC(ERR(1))
+141 ; DEVELOPEMENT DISPLAY
+142 ;D DISP
+143 ; Reset working variables
+144 DO RESET
+145 QUIT
End DoDot:2
QUIT
+146 QUIT
End DoDot:1
+147 ;
+148 ; Kill the message arrays and variables that are produced by VA FileMan.
+149 DO CLEAN^DILF
+150 ; End of processing
+151 QUIT
DESC(REC) ; Process description text and put it into the file
+1 ; If there is no description text then quit
+2 IF 'APSSDESC
QUIT
+3 SET APSSIEN=REC_","_APSSCMD_","
+4 ; Process Description text data statements
+5 ; Initialize counters
SET APSSDEND=APSSCLC+APSSDESC
SET APSSDBEG=APSSCLC+1
+6 ; Loop through the description text for this data tag
+7 FOR APSSLINE=APSSDBEG:1:APSSDEND
SET APSSDAT=$PIECE($TEXT(DATA+APSSLINE),";",2)
Begin DoDot:1
+8 ; Set up data array t be processed by VA Fileman.
+9 SET TMP("WP",APSSLINE)=APSSDAT
SET APSSDAT=""
+10 QUIT
End DoDot:1
+11 ;
+12 ; If Description lines were defined then adjust process looping position
+13 ; and send the data to VA Fileman to put into the database.
+14 IF APSSLINE
SET APSSCLC=APSSLINE
SET APSSLINE=""
Begin DoDot:1
+15 ;
+16 ; File the description text
+17 DO WP^DIE(9009033.31,APSSIEN,2,"K","TMP(""WP"")","ERR(""WP"")")
+18 QUIT
End DoDot:1
+19 ;
+20 QUIT
FDA ;
+1 ; Build FDA Array to define file structure and field values for use by Fileman
+2 SET FDA(9009033.31,APSSIEN,.01)=APSSTAG
+3 IF $GET(APSSUTAG)]""
SET FDA(9009033.31,APSSIEN,.01)=APSSUTAG
+4 SET FDA(9009033.31,APSSIEN,.02)=APSSSEQ
+5 SET FDA(9009033.31,APSSIEN,.03)=APSSFLD
+6 SET FDA(9009033.31,APSSIEN,.04)=APSSFMT
+7 SET FDA(9009033.31,APSSIEN,1)=APSSTRAN
+8 QUIT
RESET ;
+1 ; Reset working variables to NULL once each record is processed
+2 ; Data Tag
SET APSSTAG=""
+3 ; Sequence
SET APSSSEQ=""
+4 ; File/Field
SET APSSFLD=""
+5 ; Format
SET APSSFMT=""
+6 ; Transform
SET APSSTRAN=""
+7 ; Description
SET APSSDESC=""
+8 KILL TMP,FDA,ERR,ACTION,APSSUTAG
+9 QUIT
MSG ; Set up informational messages to display to the screen
+1 ;
+2 IF '$GET(ERR)
Begin DoDot:1
+3 IF ACTION="ADD"
DO MES("Data Record: "_APSSTAG_" has been ADDED.")
+4 IF ACTION="DELETE"
DO MES("Data Record: "_$PIECE(APSSTAG,"@",2)_" has been DELETED.")
+5 IF ACTION="EDIT"
DO MES("Data Record: "_$PIECE(APSSTAG,"`",1)_" has been MODIFIED.")
+6 QUIT
End DoDot:1
+7 IF '$TEST
DO MES("Data Field: "_APSSTAG_" resulted in ERROR "_ERR(1))
+8 QUIT
MES(MSG,QUIT) ; Display informational messages
+1 DO BMES^XPDUTL(" "_$GET(MSG))
+2 QUIT
+3 ; INPUT ARRAY - List of current sequence numbers being used at the facility
+4 ; SQ - Sequence number needing to be changed.
+5 ;
NEWSEQ(ARRAY,SQ) ;
+1 NEW OFFSET,QUIT,NSQ
+2 SET QUIT=0
SET NSQ=SQ
+3 FOR OFFSET=.1:.1:.9
Begin DoDot:1
+4 SET NSQ=$PIECE(SQ,".")+OFFSET
+5 IF '$DATA(ARRAY(NSQ))
SET QUIT=1
QUIT
End DoDot:1
IF QUIT
QUIT
+6 IF 'QUIT
SET NSQ=SQ+.01
+7 QUIT NSQ
+8 ; *************************************************************************
+9 ; Structure of data statements found below the DATA line tag.
+10 ;
+11 ; DATA TAG^SEQUENCE^FILE,FIELD^FORMAT~TRANSFORM~NUMBER OF DESC. TEXT LINES
+12 ; NOTE:
+13 ; If there is a number in the last "~" piece then, there is description text
+14 ; which may be multiple lines of text. That text will follow the data line
+15 ; and preceed the next data line. The FOR loop reading the data statements
+16 ; will be adjusted to skip over the description text. A secondary loop will
+17 ; read and process the description data.
+18 ;
+19 ; To delete a record an "@" must appear as the first character of the data
+20 ; string.
+21 ;
+22 ; To modify a record use the Umlaut "`" as a flag in the first piece of the
+23 ; data string indicating it is an update. If the first "^" piece is to be
+24 ; modified then the NEW value must appear in the SECOND "`" piece.
+25 ;
DATA ; This module holds the data that will be put into the database.
+1 ;
+2 ;Patient Gender^3.2^2,.02^Z~S VAL=$$GET1^DIQ(2,$P(RX0,U,2),.02)~1
+3 ;Patient Gender Designator
+4 ;Patient Address^3.3^^Z~S VAL=$$PADDR^APSSLIC($P(RX0,U,2))~1
+5 ;Patient Address
+6 ;Provider Class^31^200,53.5^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.5)~1
+7 ;Provider Class
+8 ;Provider DEA#^32^200,53.2^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.2)~1
+9 ;Provider DEA#
+10 ;Site DEA#^33^^Z~S VAL=$$SDEA^APSSLIC($P(RX0,U,5))~1
+11 ;Site DEA#
+12 ;Site Name^34^^Z~S VAL=$$SNAME^APSSLIC($P(RX0,U,5))~1
+13 ;Site Name
+14 ;Issue Date^35^52,1^Z~S VAL=$$FMTE^XLFDT($P(RX0,U,13),"5Z")~1
+15 ;Issue Date
+16 ;Login Date^37^52,21^Z~S VAL=$$FMTE^XLFDT($P(RX2,U),"5Z")~1
+17 ;Login Date
+18 ;License Number^36^200.541,1^ZR~S VAL=$$EP1^APSSLIC($$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I"),2)~17
+19 ;Provider License Number
+20 ;
+21 ; Parameter 1 passed to APSSLIC routine represents the Provider Internal Entry Number
+22 ; Paramneter 2 represents the processing method which is described below..
+23 ;
+24 ; Method 1
+25 ; Match it to the state the facility is in
+26 ; If there is no license for that state then return any valid license
+27 ; If no valid license found for any state then return NULL
+28 ;
+29 ; Method 2
+30 ; There is no license for the state the facility is in then,
+31 ; return NULL even if other states have a valid license defined.
+32 ;
+33 ; Method 3
+34 ; Return first valid license found regardless of state
+35 ; No valid license found, then return NULL
+36 ;
+37 ;EOD
+38 QUIT
