SDVWAPP ; VWSD VOE APP FOR SDAPI AND MAKE APPOINTMENT RPC routines
 ;;5.3;Scheduling;**502**;Aug 13, 1993  ;Build 14
 ; Copyright (C) 2007 WorldVistA
 ;
 ; This program is free software; you can redistribute it and/or modify
 ; it under the terms of the GNU General Public License as published by
 ; the Free Software Foundation; either version 2 of the License, or
 ; (at your option) any later version.
 ;
 ; This program is distributed in the hope that it will be useful,
 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ; GNU General Public License for more details.
 ;
 ; You should have received a copy of the GNU General Public License
 ; along with this program; if not, write to the Free Software
 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
 ;
SDAPI(RESULTS,SDARRAY) ;;
 ; SDAPI APP TEST PROGRAM ( RETURN LIST OF APPOINTMENTS)
 ; VERSION 3.1
 N FIRST,SSN,SDDATE,SDLOCATE,PATIENTN,SSNPATN,AJJ3VIS,SDARRAY2,COUNTER
 N MSGCTRL,IER,RETURN,ORDRSORT,SSN,SDLOCATE,SDDATE,SDCOUNT,ACKCODE
 S MSGCTRL=0
 ;;;;S SDARRAY(1)="Nov 6,2006;Nov 9,2006"
    I $G(SDARRAY(1))="" S RESULTS(0)="UNDEFINED DATE RANGE ELEMENT" Q
 ;;;;;;S SDARRAY(3)="R;I" 
 I $G(SDARRAY(3))="" S RESULTS(0)="UNDEFINED ELEMENT 3 = "_"R;I" Q
 ;;;;;;S SDARRAY(2)="VWVOE RADIOLOGY CLINIC" ;EXTERNAL NAME
 I ($G(SDARRAY(2))="")&($G(SDARRAY(4))="") S RESULTS(0)="UNDEFINED ELEMENTS 2 AND 4 TOGETHER" Q
 ;AS WELL AS S SDARRAY(4)="100001298" ;EXTERNAL PATIENT ID AS SSN
 ;;;;;;S SDARRAY("MAX")=3 
 I $G(SDARRAY("MAX"))="" S RESULTS(0)="UNDEFINED MAX RETURN ELEMENT" Q
 ;;;;;;;S SDARRAY("FLDS")="1;2;3"
 I $G(SDARRAY("FLDS"))="" S RESULTS(0)="UNDEFINED FLDS ELEMENT" Q
 S RESULTS(0)="UP TO HERE SDAPI"
 ;Q
 S IER=$$TRNSDAPI^SDVWHLE2(.SDARRAY,.MSGCTRL)
 I (IER="OK")&(MSGCTRL'=0) D
 .S AJJ3CNT=0
CHKAGAIN .I AJJ3CNT>27 Q
 .I $D(^XTMP(MSGCTRL,"RETURN"))=0 H 3 S AJJ3CNT=AJJ3CNT+1 G CHKAGAIN
 .;W !,"HERE"
 .S RETURN=^XTMP(MSGCTRL,"RETURN") ; THIS INCLUDES ACK CODE AS AA OR AE
 .S ACKCODE=$P(RETURN,"^",1)
 .I ACKCODE="OK" D
 ..;
 ..S ORDRSORT=$P(RETURN,"^",2)
 ..S SDCOUNT=$P(RETURN,"^",3)
 ..I SDCOUNT>0 D
 ...D
 ....I $E(ORDRSORT,1,1)="P" D
 .....S AJJ3VIS=0
 .....F  S AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) Q:AJJ3VIS=""  D
 ......S SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
 ......S SSNPATN=$P(SDARRAY2,"^",1)
 ......S SDLOCATE=$P(SDARRAY2,"^",2)
 ......S SDDATE=$P(SDARRAY2,"^",3)
 ......S FIRST=SSNPATN_"^"_SDLOCATE_"^"_SDDATE_"^"
 ......S SDARRAY2=$P(SDARRAY2,FIRST,2)
 ......S PATIENTN=$P(SSNPATN,"#",2)
 ......S SSN=$P(SSNPATN,"#",1)
 ......S COUNTER=(AJJ3VIS-1)*2
 ......S RESULTS(COUNTER+1)="APPT/UNSCHED VISIT, PATIENT="_PATIENTN_" SSN="_SSN_" HOSP LOCATION="_SDLOCATE_" DATE/TIME="_SDDATE
 ......S RESULTS(COUNTER+2)="                   DATA FIELDS="_SDARRAY2
 ....I $E(ORDRSORT,1,1)="C" D
 .....S AJJ3VIS=0
 .....F  S AJJ3VIS=$O(^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)) Q:AJJ3VIS=""  D
 ......S SDARRAY2=^XTMP(MSGCTRL,"SDAMA301",AJJ3VIS)
 ......S SSNPATN=$P(SDARRAY2,"^",2)
 ......S SDLOCATE=$P(SDARRAY2,"^",1)
 ......S SDDATE=$P(SDARRAY2,"^",3)
 ......S FIRST=SDLOCATE_"^"_SSNPATN_"^"_SDDATE_"^"
 ......S SDARRAY2=$P(SDARRAY2,FIRST,2)
 ......S PATIENTN=$P(SSNPATN,"#",2)
 ......S SSN=$P(SSNPATN,"#",1)
 ......S COUNTER=(AJJ3VIS-1)*2
 ......S RESULTS(COUNTER+1)="APPT/UNSCHED VISIT, HOSP LOCATION="_SDLOCATE_" PATIENT="_PATIENTN_" SSN="_SSN_" DATE/TIME="_SDDATE
 ......S RESULTS(COUNTER+2)="                   DATA FIELDS="_SDARRAY2
 ..E  D
 ...S RESULTS(1)="SDCOUNT="_SDCOUNT  ;LOOK AT ERRORS IN API CALL, ETC
 E  D
 . S RESULTS(1)=RETURN ; APP ACK CODE="AE". SOME OTHER ERRORS IN TRANSMISSION IN OTHER PIECES OF RETURN
 S RESULTS(0)="MSGCTRL="_MSGCTRL ;;;;;;;;;W !,"MSGCTRL=",MSGCTRL
 I (MSGCTRL'=0) K ^XTMP(MSGCTRL)
 Q
MKPI(RESULTS,SDARRAY1) ;
 ;MAKE Appointment APP TEST PROGRAM
 ;
 N MSGCTRL,IER,RETURN,DUZ1
 N PATIENTN,SSN,SD1,SC,STYP,OUTIN,SDVWNVAI,X,Y,X2,ACKCODE,SDARRAY
 N AJJ3CNT
 N VXSDNVAI
 S MSGCTRL=0  ;
 ;N DFN(SSN AND PATIENT NAME INSTEAD),SD1,SC(HOSP LOCATION (CLINIC) EXT FORMAT NAME INSTEAD,STYP,
 ;N SDARRAY (DATE/TIMES IN EXTERNAL FORMAT),IER
 I $G(SDARRAY1("PATIENTN"))="" S RESULTS(0)="NO DEFINED PATIENTN ELEMENT" Q
 S PATIENTN=SDARRAY1("PATIENTN") ; S PATIENTN="ZZ PATIENT,TEST ONE"
    S SDVWNVAI="D"  ; NON-VA TESTING HERE WITH DISABLING THE NEED FOR ICN
 I $G(SDARRAY1("SSN"))="" S RESULTS(0)="NO DEFINED SSN ELEMENT" Q
 S SSN=SDARRAY1("SSN")  ; S SSN=100001298 ; DFN=1 NON TEST PATRIENT FOR PFSS EVENT GENERATION
 I $G(SDARRAY1("SD1"))="" S RESULTS(0)="NO DEFINED SD1 APPT DATE ELEMENT"
 S SD1=SDARRAY1("SD1")  ; S SD1="JAN 24,2007@11:30" ; SD1=3070123.1130  
 ;S X=SD1 D ^%DT S SD1=Y
 I $G(SDARRAY1("SC"))="" S RESULTS(0)="NO DEFINED APPOINTMENT CLINIC ELEMENT" Q
 S SC=SDARRAY1("SC")   ; "VWVOE RADIOLOGY CLINIC" ; S SC=3 
 S STYP=3  ;SCHEDULED APPT
 S OUTIN="O" ;for outpatient clinic
 ;
 D NOW^%DTC S X2=X\1 S Y=X2 D DD^%DT S SDARRAY("DATE NOW")=Y
 ;D NOW^%DTC S X2=X\1 S Y=X2 D DD^%DT S SDARRAY("DATE NOW")=Y
 S SDARRAY("APPT TYPE")=9
    S SDARRAY("SCHED_REQ_TYPE")="O" ;'OTHER THAN NEXT AVAIABLE
    S SDARRAY("NEXT APPT IND")=0 ;0 FOR NO
    S SDARRAY("FOLLOWUP VISIT INDICATOR")=0  ; 0 FOR NO
 ;CHECK FOR DUZ IN SDARRAY1("DUZ") FOR DATA ENTRY CLERK
 I $G(SDARRAY1("DUZ"))="" S RESULTS(0)="NO DUZ ELEMENT RETURNED" Q
 S DUZ1=SDARRAY1("DUZ")
 ;GET NAME FOR DUZ IN NEW PERSON FILE
 S SDARRAY("DATA ENTRY CLERK")=$P($G(^VA(200,DUZ1,0)),"^",1)
    ;;;;;;;;;S SDARRAY("DATA ENTRY CLERK")="SCHLEHUBER,CAMERON" ; PERSON ON MACHINE MAKING APPT REMOTELY
    ;THEN PARAMETERS CONVERTED TO INTERNAL VALUE
    S RESULTS(0)="UP TO HERE MAKE APPT"
 ;Q
 S IER=$$TRNSMKPI^SDVWHLE1(PATIENTN,SSN,SD1,SC,STYP,.SDARRAY,OUTIN,.MSGCTRL,SDVWNVAI)
 ;SDVWNVAI AS LAST PARAMETER PASSED
 I (IER="OK")&(MSGCTRL'=0) D
 .S AJJ3CNT=0
CHKGAIN .I AJJ3CNT>8 Q
 .I $D(^XTMP(MSGCTRL,"RETURN"))=0 H 3 S AJJ3CNT=AJJ3CNT+1 G CHKGAIN
 .S RETURN=^XTMP(MSGCTRL,"RETURN") ; THIS INCLUDES ACK CODE AS AA OR AE
 .S ACKCODE=$P(RETURN,"^",1)
 .I ACKCODE="AA" D
 ..S RESULTS(1)=ACKCODE_" MAKE APPT GOOD RETURN"
 .E  D
 ..;ACKCODE="AE". LOOK AT SOME OTHER ERRORS IN TRNSMISSION IN OTHER PIECES OF RETURN
 ..S RESULTS(1)=ACKCODE_" RETURN="_RETURN
 S RESULTS(0)="MSGCTRL="_MSGCTRL
 I (MSGCTRL'=0) K ^XTMP(MSGCTRL,"RETURN")
 Q